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Introduction  1 


Introduction 


"Software  is  52  of  the  USAF’s  budget,  62  of  NASA’s  budget  and  is  a 
10  billion  dollar  a year  industry  (over  12  of  the  GNP)." 

Standish  [S  74) 


"Of  the  estimated  DOD  software  cost  of  S2.5  billion  previously  identified, 
362  was  for  analysis,  152  for  coding,  and  472  for  validation  according 
to  the  Air  Force  study.  ARPA  is  spending  annually  15.5  million 
developing  techniques  to  enable  the  computer  itself  to  write  and  debug 
programs,  given  only  a specificaion  of  the  problem  and  the  results 
desired." 

Lukasik  [L  75] 


"The  one  invariant  in  the  computer  field  - whether  mainframe,  mini,  or 
micro  - is  increasing  software  costs.  „.75  percent  of  the  mainframe 
system  dollar  currently  goes  for  software.  ...Systems  software  typically 
represents  50  percent  of  the  mini  manufacturer's  development  budget 
(hardware  costing  40  percent  and  services  making  up  the  remaining  10 
percent).  ...software  costs  tend  to  dominate  in  under- 100-unlt  quantities 
- even  on  micros." 

Davis  [D  78b] 
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Software  is  expensive  and  too  often  bug  ridden.  "Debugging*  is  still  the  most 
commonly  used  method  of  increasing  confidence  in  the  correctness  of  a program.  As 
indicated  by  the  statistics  above,  validation  of  the  correctness  of  programs  is  a difficult 
and  expensive  task.  Many  approaches  have  been  proposed  to  ensure  reliable 
programs,  some  dealing  with  the  programming  task  and  others  with  proving  a 
completed  program  does  what  is  intended.  Verification  techniques  have  been 
developed  to  prove  that  a program  meets  its  specifications. 

Several  attempts  have  been  made  to  provide  automatic  verification  systems. 
Some  of  these  systems  are  good  at  proving  verification  conditions  for  a specific 
problem  domain,  employing  strategies  that  are  geared  to  that  domain;  however,  the 
ability  to  handle  problems  in  a new  subject  domain  typically  requires  extensive 
modifications  of  the  system. 

A much  harder  problem  is  discovery  of  the  verification  conditions  to  be  proved. 
One  must  find  assertions  (statements  of  first  order  logic)  that  characterize  the  desired 
behavior  of  the  program.  It  is  difficult  enough  to  read  someone  else's  program  and 
determine  what  is  actually  going  on,  let  alone  figure  out  what  the  programmer  had 
intended  to  do.  Even  when  verification  is  done  by  the  original  programmer,  we  are 
asking  a lot.  This  person  must  be  able  (assuming  a structured  approach  to  the  task)  to 
move  from  logical  assumptions  about  the  problem  domain  (whether  or  not  ti>ese  are 
stated  formally)  to  an  implementation  in  a programming  language,  and  then  back 
again  to  the  logical  base  as  a source  of  assertions  from  which  the  verification 
conditions  can  be  derived. 
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It  is  possible  to  generate  some  of  these  assertions  automatically  from  the  text  of 
the  program.  Usually  the  programmer  supplies  the  critical  assertions  on  which  his 
program  was  based,  letting  the  machine  fill  in  the  necessary  details.  However,  one 
might  question  the  validity  of  this  approach.  A “proof  of  correctness"  is  really  just  a 
proof  of  equivalence  of  two  specifications  of  the  problem,  one  expressed  in  logic,  the 
other  in  a programming  language.  If  we  derive  the  assertions  (manually  or 
automatically)  from  the  program  itself,  then  we  lose  the  redundancy  of  the  two 
specifications;  i.e.,  we  lose  the  basis  of  our  confidence  that  the  verification  provides  an 
indication  of  true  correctness. 

Furthermore,  if  verification  fails,  several  explanations  are  possible.  Perhaps  the 
program  is  incorrect;  perhaps  the  specifications  are  incorrect  or  incomplete;  perhaps 
the  verifier  is  incorrect  or  not  sufficiently  powerful  to  find  a proof  even  though  one 
does  exist.  If  verification  is  successful,  then  again  several  explanations  are  possible. 
Perhaps  we  have  a correct  program;  perhaps  the  verifier  has  made  a mistake. 
Assuming  that  the  verifier  contains  no  bugs,  we  have  a proof  that  the  program  meets 
its  specifications,  but  the  specifications  may  not  be  an  accurate  embodiment  of  what 
we  had  in  mind. 

Therefore  several  researchers,  the  author  included,  feel  that  a specification  of  the 
task  should  be  written  before  a program  is  written  to  acomplish  the  task.  The 
specification  should  be  written  in  a high  level  language  that  enables  one  to  describe 
what  is  to  be  accomplished,  indicating  functional  relationships  without  having  to 
consider  computational  details.  Such  a specification,  in  which  only  the  abstract 
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description  of  the  problem  is  required,  is  less  prone  to  error  than  a typical 
programming  language  specifics  t in  which  every  detail  of  the  computation  must  be 
provided.  The  problems  of  incomplete  or  incorrect  specifications  do  not  go  away, 
however  we  claim  they  are  more  tractable  with  this  approach. 

Program  synthesis  is  the  generation  of  a computational  specification  of  a 
problem  or  task  from  a descriptive  specification.  Again,  we  do  not  have  the 
redundancy  of  two  specifications,  one  descriptive  and  one  computational,  both  written 
by  the  programmer,  but  we  feel,  as  discussed  above,  that  the  descriptive  specification 
is  less  prone  to  error.  Several  approaches  to  program  synthesis  are  currently  being 
investigated.  We  shall  review  them  briefly  here;  more  detail  is  given  in  the  section  on 
historical  background. 

The  field  of  programming  methodology  has  offered  a great  deal  of  assistance, 
pointing  out  ways  to  write  a program.  Most  notable  and  generally  accepted  is 
Dijkstra's  approach  of  "structured  programming",  also  called  "stepwise  refinement" 
(Wirth),  of  the  problem.  Although  intended  as  a discipline  for  humans  to  follow,  it 
also  provides  guidelines  that  can  be  elaborated  to  direct  programming  by  the 
computer  itself,  perhaps  with  human  intervention. 

Several  investigators  have  taken  a deductive  approach  to  the  stepwise  refinement 
process.  The  computer  is  given  specific  rules  by  which  it  can  rewrite  statements 
syntactically  while  maintaining  equivalent  meaning.  This  kind  of  program  synthesis  is 
closely  related  to  program  transformation.  The  intent  of  a program  transformation 
system  is  to  make  the  given  program  more  efficient  while  preserving  its  meaning.  A 
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typical  transformation  is  one  that  replaces  recursion  by  iteration,  although  this  does 
not  always  result  in  greater  efficiency.  In  a synthesis  system,  a descriptive  statement  in 
a specification  language  is  transformed  into  an  operational  statement  in  a 
programming  language.  The  specification  language  mav  be  a superset  of  the  target 
programming  language.  The  system  successively  refines  a high  level  description  into  a 
lower  level  (computational)  description. 

Less  formal  techniques  have  also  found  favor.  Natural  language  dialogues  have 
been  used  to  describe  a problem  to  the  computer.  The  user  of  this  kind  of  system 
specifies  the  task  at  a general  level,  filling  in  the  details  as  requested  by  the  computer. 

Still  other  approaches  employ  specification  by  example.  Some  systems  synthesize 
programs  from  sample  input-output  pairs.  For  example,  the  pair 

(a  (b  c)  d)  ->  (d  (b  c)  a) 

might  indicate  a procedure  to  reverse  the  elements  in  a list.  It  might  also  represent  a 
procedure  to  switch  the  first  and  last  elements  of  a list;  thus,  one  must  be  sure  to 
provide  a sufficient  set  of  examples  to  determine  the  desired  function. 

Another  attempt  at  synthesis  by  example  provides  sample  execution  traces.  For 
example,  the  sequence 

(4  14)  ->  (2  4)  ->  (0  2)  ->  2 

might  suggest  the  Euclidean  algorithm  for  finding  the  greatest  common  divisor  of  two 
integers. 

Each  of  the  techniques  mentioned  above  have  been  investigated  as  a means  to 
synthesize  programs  in  a specific  target  language.  It  is  our  thesis  that  the  synthesis  of 
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an  algorithm  is  a target-language-independent  process.  We  have  implemented  a 
system  to  generate  programs  from  logic  specifications.  The  system  is  "reasonably" 
targei-language-indepenu .. .,  as  will  be  explained  later  on.  The  specifications  are 
first  translated  into  an  intermediate  language  and  then  a program  is  generated  from 
the  intermediate  form.  We  drop  the  word  "synthesis"  and  use  program  "generation" 
instead  to  avoid  any  misunderstanding  of  the  claims  being  made.  The  specification 
language  for  this  system  includes  a subset  of  first-order  Predicate  Calculus  known  as 
Horn  Clauses.  The  specifications  we  require  are  "descriptive"  in  that  they  specify  the 
logic  of  the  program  without  specifying  the  control,  but  they  are  also,  in  part, 
"computational"  in  that  the  Horn  clauses  couid  be  "run"  as  programs  given  a complete 
theorem  prover,  or  logic  interpreter. 

The  system  was  implemented  in  MACLISP  on  a DEC  KL10  at  the  Stanford 
Artificial  Intelligence  Laboratory.  In  this  dissertation  we  describe  the  implementation 
and  prove  that  it  provides  a valid  way  to  derive  correct  programs.  This  is 
accomplished  by  proving  that  the  top  level  mappings  from  specification  to 
intermediate  language  to  target  program  (the  proof  is  for  the  mapping  to  LISP)  are 
correct;  the  entire  implementation  is  not  proved  correct. 

We  begin  by  giving  a brief  history  of  the  approaches  taken  by  other 
investigators  in  this  area,  and  then  describe  the  system  invented  by  the  author.  We 
form»',y  describe  the  specification  language  via  a context-free  description  of  the 
syntax  (see  page  22)  and  an  axiomatic  specification  of  the  semantics  (see  page  24). 
Motivation  for  requiring  particular  items  in  the  specification  is  provided  as  well. 
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The  relationship  between  a specification  and  a program  written  for  a logic 
interpreter  is  explored  in  Chapter  4, page  28). 

We  then  describe  the  intermediate  language  in  detail,  again  supplying  a 
context-free  grammar  for  the  syntax  (see  page  35),  and  the  axiomatic  semantics  (see 
page  36). 

The  mapping  from  specification  language  to  intermediate  language  is  described 
by  means  of  a function  /,  for  internalize,  and  we  prove  that  this  mapping  preserves 

the  axiomatic  semantics  of  the  specifications. 

We  then  describe  the  mapping  from  the  intermediate  language  to  LISP  and 
prove  that  the  semantics  is  again  preserved  by  the  translation. 

In  Chapter  10,  we  describe  how  to  extend  the  system  to  handle  generation  of 
programs  in  more  languages.  The  additions  required  for  each  new  language  are 
referred  to  as  a 'back  end"  for  that  language.  The  implementation  of  the  "back  end" 
for  LISP  and  that  for  Pascal  are  also  discussed. 

We  include  some  notes  on  the  implementation  and  then  discuss  the  conclusions 
that  can  be  drawn  from  this  effort,  as  well  as  topics  of  further  research  that  were 
suggested  by  the  pro ject. 

The  appendices  include  several  sample  specifications  and  the  programs 
generated  from  them,  the  specification  of  a program  generation  system,  and  the  listing 
of  the  entire  system  along  with  the  code  that  implements  the  "back  end"  for  LISP  and 
that  for  Pascal. 

This  system  described  is  unique  in  its  ability  to  generate  programs  in  more  than 
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one  language.  The  recipe  provided  explains  how  to  construct  the  additions  required 
for  any  new  language.  Given  the  back-end  describing  a particular  target  language,  we 
can  synthesize  the  system  itself  in  the  language,  making  it  immediately  portable.  More 
importantly,  it  provides  a means  of  obtaining  correct  programs  that  is  decidedly  less 
painful  than  verification.  The  user  is  still  required  to  specify  the  logic  of  a program, 
but  the  language  used  in  the  specification  frees  the  user  from  concerns  of 
representation  and  implementation. 

The  sobering  fact  remains  that  regardless  of  how  (or  when)  we  arrive  at 
specifications  for  a program,  we  can  have  no  guarantee  of  their  correctness  (in  the 
sense  that  we  have  both  a true  and  complete  specification  of  the  problem  we  had  in 
mind),  and  any  attempt  at  verification  of  a program  is  simply  a proof  of  equivalence 
of  program  and  specifications.  We  simply  do  the  best  we  can  to  increase  our 
confidence  that  our  programs  accomplish  their  intended  purpose. 
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History 


Computer  scientists  have  always  looked  for  ways  to  make  the  programming  task 
easier  and  less  prone  to  error.  The  natural  way  to  accomplish  this  is  by  using  the 
computer  itself  as  much  as  possible  to  do  its  own  coding.  The  theoretical  foundation 
for  automatic  programming  was  established  by  Klecne  [K  52]  in  the  1940’s.  Kleene 
proved  that  if  the  existence  of  a number  satisfying  certain  properties  can  be  proven  in 
a formal  intuitionist  system,  1 then  the  definition  of  a function  computing  that 
number  can  be  extracted  from  the  proof.  The  first  major  attempt  at  automatic 
programming  was  the  development  of  FORTRAN. 


"If  it  were  possible  for  the  704  to  code  problems  for  itself  and  produce 
as  good  programs  as  human  coders  (but  without  the  errors),  it  was  clear 
that  large  benefits  could  be  achieved.  ...The  goal  of  the  FORTRAN 


'An  intuitionist  system  allows  only  constructive  proofs.  See  [K  521 
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project  was  to  enable  the  programmer  to  specify  a numerical  procedure 
using  a concise  language  like  that  of  mathematics  and  obtain 
automatically  from  this  specification  an  efficient  704  program  to  carry 
out  the  procedure." 

Backus,  et.  al.  [B  57] 

In  the  1960’s  several  high  level  languages  were  introduced  as  means  of  specifying 
problems  to  the  computer  in  a way  more  natural  to  us,  letting  the  machine  do  the 
coding.  Over  the  years,  our  concept  of  "automatic  programming"  has  changed.  We 
no  longer  consider  a compiler  an  automatic  program  synthesizer. 

J.  R.  Slagle  [S  65]  applied  his  question  answering  program  "DEDUCOM"  to  the 
task  of  generating  programs.  The  relation  between  input  and  output  was  expressed  in 
predicate  calculus.  His  technique  was  to  prove  a theorem  and  write  a program  by 
keeping  track  of  the  substitutions  made  for  certain  crucial  variables  in  the  course  of 
the  proof. 

A similar  approach  was  described  by  Waldinger  [W  69].  He  extended  the 
technique  allowing  branches  and  loops  to  be  written.  Again,  specifications  for  the 
program  were  described  in  Predicate  Calculus  as  a relation  between  input  and  output 
variables.  Mechanical  theorem  proving  techniques  were  used  to  generate  a 
constructive  proof  of  the  existence  of  output  values  satisfying  the  specifications.  A 
program  was  then  extracted  from  the  proof. 

Since  1970,  several  approaches  to  program  synthesis  have  been  investigated. 
The  resolution  theorem  proving  approach  proved  to  be  impractical,  requiring  too 
much  space  while  considering  all  possibilities.  Lee  and  Chang  [LC  74]  proposed  to 
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overcome  the  memory  saturation  problem  with  an  interactive  system  based  on  the 
concept  of  structured  programming.  Using  the  technique  of  stepwise  refinement,  a 
program  was  generated  in  terms  of  subprograms  until  each  subprogram  became  an 
"atomic  program",  i.e.  executable.  At  each  step,  some  appropriate  information  would 
be  selected  by  the  user  for  the  computer  to  use  to  generate  a subprogram.  In  this  way, 
the  computer  only  had  to  handle  a small  amount  of  information. 

Many  researchers  abandoned  resolution  methods  entirely  in  favor  of  deductive 
systems  with  many  rules  of  inference.  Buchanan  developed  a system  [B  74]  based  on 
the  program  verification  formalism  of  Hoare  [ILL  751  Input  to  the  system  was  given 
in  "frames"  composed  of  assertions,  state  descriptions,  axioms  and  rules.  A rule  could 
be:  a primitive  procedure  with  preconditions  and  postconditions  specified;  a definition, 
stating  the  equivalence  of  two  assertions;  or  an  iterative  rule  specifying  conditions  that, 
if  satisfied,  would  justify  the  assembly  of  a “while"  loop  to  achieve  the  associated  goal. 
The  input  specifications  were  rather  complicated.  An  iterative  rule  involved 
specifying  a name,  a basis  assertion,  a loop  invariant,  an  iteration  step  assertion,  an 
iterative  goal,  a loop  control  test,  and  an  output  assertion  (the  last  two  could  possibly 
be  the  same  as  the  iterative  goal).  It  was  also  possible  to  give  advice  to  the  system 
interactively,  to  guide  the  synthesis  process.  This  system  could  automatically  generate 
conditional  statements  as  well. 

Dershowitz  and  Manna  [DM  75]  discussed  formalization  of  several 
programming  techniques  involved  in  structured  programming,  and  demonstrated  the 
use  of  these  rules  by  hand-synthesizing  programs.  Manna  and  Waldinger  [MW  77c] 
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have  implemented  *uch  techniques  in  "DEDALUS",  an  experimental  program 
synthesis  system.  They  have  attempted  to  make  life  easier  for  the  user  by  simplifying 
the  input  required.  They  have  not,  as  yet,  attempted  to  describe  completely  their 
specification  language;  it  is  a superset  of  the  target  language  containing  quantifiers 
and  several  high-level  constructs  from  the  subject  domain.  Hundreds  of 
transformation  rules  are  available,  embodying  a great  deal  of  knowledge  about  the 
domain  for  which  programs  are  to  be  synthesized.  The  transformations  include  rules 
for  recursion  formation,  conditional  formation,  and  procedure  formation.  A goal 
given  as  input  is  transformed  into  subgoals  until  a primitive  program  to  accomplish  it 
is  derived.  Strategic  controls  are  used  to  choose  among  possible  synthesis  paths. 

Burstall  and  Darlington  [BD  75]  described  a formal  system  for  manipulation 
and  optimization  of  recursive  functions.  The  language  they  use  is  that  of  recursion 
equations.  Darlington  [D  75]  extended  this  language  to  include  set  notation  (having 
been  influenced  by  the  work  of  Manna  and  Waldinger),  and  described  the  application 
of  the  transformation  system  to  the  problem  of  program  synthesis.  (The  difference 
between  program  transformation  and  program  synthesis  lies  in  the  degree  of 
abstraction  in  the  specification  one  staru  with.)  Non-trivial  algorithms  have  been 
derived  manually  using  the  transformation  rules  of  the  system,  however  cleverness  is 
still  needed  at  some  points  to  determine  which  rules  to  apply. 

Clark  and  Sickel  [CS  77]  describe  the  process  of  deriving  computational  logic 
programs  (defined  by  Sickel  [S  77a])  from  axiomatic  specifications.  The  process  was 
investigated  using  hand  synthesis  of  programs,  but  an  interactive  system  wu  intended 
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to  be  implemented  that  would  become  more  automatic  as  the  synthesis  methodology 
was  refined.  Clark  and  Darlington  [CD  7S]  further  this  methodology  using  a 
compromise  notation  of  logic  and  recursion  equations,  making  the  results  applicable  in 
both  formalisms.  They  describe  the  synthesis  of  recursive  function  definitions  from 
axiomatic  specifications.  Sickel  [S  77a]  also  described  a methodology  for  continuing 
the  process  down  to  an  executable  form  in  a "conventional"  programming  language. 
By  doing  a theorem  proving  style  of  analysis  of  the  logic  program  one  can  derive  a 
tree  representing  all  possible  proofs  of  the  program  taken  as  a theorem.  A regular 
expression  is  used  to  describe  a computation  path  representing  all  proofs  of  the 
theorem.  This  computation  path  may  then  be  mapped  into  a program  in  the  target 
programming  language. 

Observing  that  the  structure  of  a program  is  often  determined  by  the  structure 
of  the  data  it  operates  on,  von  Henke  [H  75]  organized  knowledge  about  the  data 
domain  and  represented  it  in  such  a way  that  it  can  directly  assist  a system  in 
constructing  programs.  He  used  LCF  (Logic  for  Computable  Functions),  extended  to 
include  terms  for  expressions  involving  sets  and  bounded  quantification,  as  the 
problem  specification  language.  The  fact  that  every  LCF  term  also  has  an 
interpretation  as  a computational  rule  for  the  function  denoted  by  it  allows  the  term  to 
be  regarded  as  a program.  Data  type  definitions  are  used  to  generate  ’characterizing'' 
functions  (identity  on  the  type  defined  and  undefined  elsewhere)  which  can  then  be 
abstracted  into  functionals  for  homomorphic  and  endomorphic  extension.  For 
instance,  a predicate  to  recognize  the  type  could  be  described  as  a homomorphic 
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extension  into  truth  values.  A function  to  accomplish  substitution,  "replace  free 
occurrences  of  v in  t by  t after  renaming  bound  variables  in  t so  that  no  free  variable 
in  t becomes  bound  in  the  modified  t",  can  be  expressed  as  an  endomorphism  on  the 
data  type  "expressions". 

All  of  the  approaches  mentioned  above  deal  with  formal  systems  in  which  the 
proofs  of  equivalence  of  program  and  specification  can  be  carried  out.  Many 
researchers  have  experimented  with  systems  that  automatically  write  or  modify 
programs  from  partial  specifications  in  an  ambiguous  language  (subsets  of  English), 
making  correctness  more  difficult  to  arrive  at.  Heidorn  [H  76]  reviews  four  such 
projects  that  use  natural  language  dialogues  with  the  machine  for  specification  of  the 
problem.  Most  such  projects  limit  the  area  of  application  severely.  In  his  own 
research  at  the  NPS  (Nava)  Postgraduate  School,  Monterey,  Ca.)  Heidorn  used  a 
restricted  form  of  English  as  input  and  generated  CPSS  programs  as  output.  The 
system  used  hundreds  of  decoding  and  encoding  rules  and  was  designed  for 
generation  of  programs  to  do  queueing  simulations.  These  it  did  well  with  the  author 
of  the  system  as  user. 

Another  project  aiming  at  natural  language  specification  is  being  carried  on  at 
the  Information  Sciences  Institute  of  the  University  of  Southern  California.  This 
system,  called  SAFE  [BCW  77],  is  intended  to  be  independent  of  the  problem  domain, 
and  consists  of  three  phases:  "domain  acquisition"  [CBW  781  "planning”  [WBG  771 
and  a phase  to  produce  the  final  program.  The  input  to  the  system  is  a (manually) 
parenthesized  natural  language  program  description  retaining  most  semantic 
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ambiguities  of  natural  language  but  avoiding  its  syntactic  ambiguities.  The  phases 
deal  with  the  data  and  operation  structure,  the  program  and  control  structure,  and  the 
program  variable  and  parameter  structure,  respectively. 

Lenat  [L  75]  studied  the  problems  involved  in  synthesizing  large  LISP  programs 
requiring  several  hours  of  user-system  interaction  time  to  generate  natural  language 
specifications  for  the  problem.  The  problem  domain  was  inductive  inference 
programs.  The  system  was  made  up  of  BEINGs,  experts  on  various  topics  (such  as 
coding,  probability,  or  contradiction),  capable  of  asking  and  answering  questions  of 
the  user  or  other  BEINCs.  It  was  found  that  to  be  successful  a user  had  to  be 
"familiar  with  LISP,  well-grounded  in  computer  science,  and  have  the  input-output 
behavior  clearly  in  mind."  The  system  was  constructed  with  particular  dialogues  in 
mind.  Problems  pointed  out  by  the  experiment  were  the  inflexibility  of  the  system  to 
new  dialogues,  its  dependence  on  user  reliability  (no  errors  allowed),  and  the  system’s 
inability  to  accept  new  high  level  domain-specific  knowledge  (these  additions  had  to 
be  made  through  modifications  of  the  system  itself). 

Another  approach  is  synthesis  of  programs  by  example.  Hardy  [H  75a] 
describes  a system  that  generates  LISP  functions  from  a single  input-output  pair.  He 
deals  only  in  the  domain  of  list-manipulating  functions  and  claims  that  "despite  the 
fact  that  there  are  infinitely  many  functional  extensions  of  the  input-output 
Ciopair’):  (A  B C D)  . > - ((A)  (B)  (C)  (D)) 

there  is  only  one  function  that  would  be  regarded  as  the  'obviously*  intended  one.” 
This  is  certainly  true,  and  he  has  quite  a few  examples  that  work  as  one  might  expect. 
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However  one  can  imagine  several  functions  incapable  of  being  completely 
characterized  by  a single  input-output  pair.  e.g..  any  function  which  operates 
differently  as  the  result  of  a test  on  the  data  it  recieves  as  an  argument  (if  the  first 
element  of  an  integer  list  is  even  then  ...). 

Summers  [S  77b]  uses  several  sample  input-output  pairs  to  synthesize  LISP 
functions.  This  is  acomplished  by  a senes  of  transformations  from  a set  of  examples 
to  a program.  Programs  are  synthesized  in  a subset  of  LISP  using  the  primitive 
functions  car,  cdr,  cons,  and  atom,  and  the  control  structures  of  recursion,  functional 
composition,  and  the  conditional  expression.  The  current  system,  THESYS,  is  able  to 
derive  programs  with  at  most  a single  recursive  call.  A technique  called  ’’differencing" 
is  used  to  set  up  equations  that  can  be  rewritten  as  a set  of  recurrence  relations  which 
are  then  used  to  find  the  recursive  program  satisfying  the  examples.  Another 
technique,  "variable  addition",  is  used  to  generalize  on  a set  of  examples  with  the  hope 
of  enabling  differencing  where  it  was  not  applicable  before. 

Rather  than  supply  example  input-output  pairs,  Ulrich  and  Moll  [UM  77] 
advocate  supplying  an  entire  program  as  an  example  and  establishing  an  analogy  that 
the  computer  can  use  to  derive  another  program.  By  extending  an  analogy,  a given 
program  may  be  used  to  generate  another  program  solving  a different  but  analogous 
problem.  The  analogy  formation  process  works  with  the  proof  of  the  known  program 
rather  than  with  its  code.  The  proof  is  attempted  for  the  new  domain  and  only 
altered  when  a step  is  not  valid  in  this  domain.  A change  in  the  correctness  proof 
causes  a change  in  the  code.  The  initial  analogy  must  always  be  specified  by  the  user, 
making  the  solution  of  subproblems  somewhat  awkward. 
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Biermann  and  Krishnaswamy  [BK  76]  construct  programs  from  sample 
computation  traces.  They  have  shown  that  if  there  exists  a program  capable  of 
executing  the  given  trace,  then  their  system  will  find  that  program  (or  one  equivalent 
to  it).  This  approach  assumes  the  user  has  an  algorithm  already  in  mind  (to  supply 
the  computation  trace). 

Several  of  the  above  approaches  are  brought  to  bear  in  a project  lead  by  Green 
[G  77]  at  Stanford  University.  The  PSI  program  synthesis  system  consists  of  two 
phases:  an  acquisition  phase  and  a synthesis  phase.  The  specification  is  accomplished 
through  a dialogue  with  the  user,  using  English  descriptions,  examples,  and  traces. 
The  acquisition  phase  is  made  up  of  a parser-interpreter,  a trace  and  examples 
inference  system,  a dialogue  moderator,  a domain  expert,  and  a model  builder.  The 
synthesis  phase  involves  the  interaction  of  a coder  and  an  efficiency  expert  to  refine 
the  program  model  into  an  efficient  executable  program.  The  PSI  system  is  being 
extended  as  the  group  attacks  different  problem  domains. 
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The  input  to  the  system  is  a sequence  of  definitions.  A target  definition  specifies 
the  target  language  to  be  used,  which  may  be  changed  during  a session  by  simply 
supplying  another  target  definition.  The  other  kinds  of  definitions  are  function,  type 
and  generic. 

A function  definition  has  six  parts,  a name,  an  input  pattern,  a formal 
parameter  list,  a precondition,  a postcondition,  and  a body. 

For  example 


function  Fact 

input  pattern?  (1  0) 

parameter  list?  (x  y) 

precond?  Intcger(x,  true)  a t(x,  0,  true). 

postcond?  lnteger(y,  true)  a >(y,  0,  true). 

body?  F actlO,  1) 

Fact(z,  w) «■  Subl(z,  zl),  Fact(zl,  ml),  *(z,  ul,  to). 


Specification  Un|«4*  1 9 


The  verbosity  in  the  indicators  is  endurable  since  the  system  types  out  the 
question  asking  for  each  part  of  the  specification  following  the  function  name.  The 
name  part  is  self-explanatory.  An  input  pattern  is  a list  of  I's  and  0’s  indicating 
which  of  the  arguments  of  the  function  being  defined  are  expected  to  hold  inp  ‘ 
values  and  which  are  used  to  carry  values  produced  during  the  computation  of  the 
function,  respectively. 

A formal  parameter  list  is  required  to  match  up  the  appropriate  arguments  for 
the  precondition  and  postcondition  specifications.  As  we  will  see,  the  formal 
parameters  are  independent  of  the  specification  of  the  body. 

The  precondition  is  a well-formed-formula  of  predicate  calculus,  defined  on  the 
input  variables,  that  is  true  only  if  the  function  is  defined  for  those  input  variables. 
By  specifying  precisely  the  domain  of  the  function  we  can  guarantee  termination  of 
each  program.  The  precondition  is  more  than  just  a type  declaration  in  the  usual 
sense,  such  as  Integer  or  Rea),  it  may  also  provide  information  such  as  " xi2 " assuming 
that  x is  an  input  variable.  Similarly,  the  postcondition  is  a predicate  formula  on  the 
output  variables  that  specifies  the  range  of  the  output.  Taken  together,  the 
precondition  and  postcondition  specify  the  functionality,  i.e.  the  domain  and  range,  of 
the  program  being  defined.  The  range  given  may  in  fact  be  larger  than  the  actual 
range  of  the  function,  but  the  domain  given  must  not  include  any  extraneous  elements. 

A body  definition  is  a set  of  Horn  clauses  that  describes  ,.ie  function,  usually 
recursively,  in  an  axiomatic  way.  Each  Horn  clause  is  an  implication,  stating  that  the 
goal  can  be  asserted  if  a set  of  subgoals  can  be  satisfied.  In  writing  a body  definition 
we  are  asserting  that  each  of  these  implications  is  true. 
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Formally,  a Horn  clause  is  a disjunction  of  literals  (atomic  formulas,  such  as 
MP(x,  2,  y)",  or  negated  atomic  formulas)  in  which  at  most  one  literal  is  positive  (not 
negated).  The  implication  form  is  derived  from  the  fact  that  (A  v -fl  v -C)  ■ 

(A  *-  B a C).  There  are  four  kinds  of  Horn  clauses: 

1)  one  with  non-empty  antecedent  and  consequent; 

2)  one  in  which  the  antecedent  is  empty  and  the  consequent  is  non-empty; 

3)  a clause  with  non-empty  antecedent  and  an  empty  consequent;  and 

4)  an  entirely  empty  clause. 

Only  the  first  two  of  these  types  of  clauses  are  used  in  function  definitions.  The 
first  is  an  implication  as  mentioned  above,  the  second  is  considered  an  assertion.  (The 
assertion  arises  from  the  fact  that  we  can  consider  the  form  of  the  implication  to  be  a 
conjunction  implying  a disjunction,  an  empty  conjunction  is  interpreted  as  true,  thus 
asserting  the  implication  "true  •*  A"  is  the  same  as  asserting  ’/4".)  Kowalski  [K  74] 
describes  the  interpretation  of  Horn  clauses  as  a programming  language.  We  will 
discuss  the  differences  between  Logic  programs  and  the  specifications  required  by  this 
jysrem  in  a later  section,  see  page  26. 

A type  definition  is  essentially  a definition  of  the  predicate  that  recognizes 
occurrences  of  the  type.  In  this  sense  it  has  the  same  form  as  any  other  function 
definition.  The  body  of  a type  definition  has  the  same  form  as  that  of  a function 
definition.  For  the  sake  of  consistency,  we  require  that  each  type  predicate  have  an 
output  variable,  just  as  any  other  function  definition  would.  Although  one  may  not 
usually  think  of  a predicate  as  needing  an  output  variable,  since  the  evaluation  of  the 
predicate  succeeds  if  and  only  if  the  answer  is  "true*,  the  inclusion  of  an  explicit 
output  variable  allows  us  to  distinguish  when  it  is  possible  to  give  an  answer  of  'false" 
from  the  case  in  which  we  simply  cannot  determine  that  the  answer  is  'true'. 
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For  example, 

type  Set 

body  ? Set(Mt-set,  true) 

Sct(  Add-elem(y,X),  trut)  *■  Set(X,  true),  Mmbtr(y,  X,  false). 

Much  of  the  information  is  implicit  in  a type  definition.  The  input  pattern  is 
always  (l  0),  the  formal  parameter  list  is  any  list  of  two  variables,  the  precondition  is 
TRUE,  and  the  postcondition  is  simply  that  the  output  variable  ends  up  with  a truth 
value. 

A generic  function  is  one  in  which  the  input  pattern  is  allowed  to  vary.  For 
example,  one  might  wish  to  define  a function  "Conca:(x,  y,  i)“,  meaning  "z  is  the  result 
of  appending  x and  y".  If  defined  as  a generic  function  we  can  use  Co^cat  in  defining 
other  functions  whenever  we  have  two  of  its  arguments  available  and  wish  to  compute 
the  third. 

The  definition  of  a generic  function  includes  its  name,  a formal  parameter  list 

(again  for  the  purposes  of  the  preconditions  and  postconditions),  a list  of  choices 

specifying  how  the  function  may  be  used,  and  possibly  more  than  one  body  definition. 

The  general  form  of  a generic  specification  is  *: 

" generic " name 
’ paramtttr  list?"  id-list 
"choices?" 
in  put- pattern  i 
"function  name?"  f unname, 

" precond ?'  precondition, 

"postcond?"  postcondition, 

"body-name?"  bodyname, 

input-pattern,, 


2The  subscripts  useo  are  for  clarity  in  the  example,  they  are  not  part  of  the 
syntax. 
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* function  namef"  funnamen 
"precondt"  precondition „ 

* postcond?"  postcondition „ 

" body-name f"  bodynamen 

"body-defs." 

name,  h-clause * 

namek  T h-clause * 

A choice  is  made  up  of  an  input  pattern,  a name  to  be  associated  with  this 
particular  style  of  call  on  the  function,  domain  and  range  specifications,  and  a body 
name  indicating  the  function  body  to  be  used.  A body  definition  associates  a body 
name  with  a definition  (i.e.  a set  of  Horn  clauses). 


3.1  Syntax  of  the  Specification  Language 

A context-free  description  of  the  input  language  is  as  follows: 
PHRASE  STRUCTURE. 

input  ,v»  definition*  *.* 

definition  .v-  fun-def  | lype-def  | gen-def  | target-def 

fun-def “ 'function " name 

’ input  pattern 7“  input-pattern 
" parameter  list t"  id-list 
" precond V precondition 
" postcondf " postcondition 

" bodyr  h-clause*  V 
type-def  .v-  'type'  name 

" bodyK  h-clause* 

gen-def  "generic"  name 

’ parameter  list ?'  id-list 

" choices t"  [cA««  " choices ?"]* 

"body-defs:"  body-def* 
target-def  .v-  "target"  target-language 
target-language  .v-  name 
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eholc*  .v-  input-pattern 

’‘function  namef"  name 
" precondK  precondition 
" postcondK  postcondition 
’ body-nameV ' name 

body-def  .7-  name  T h-dause*  V 

input-pattern  T zero-or-one* 
zero-or-one  .v«  *0"  | 
name  identifier 

id-list  .v-  V*  name*  T 

precondition  .v  disjunction 

postcondition  disjunction V 

disjunction  .v-  conjunction  | conjunction  V disjunction 

conjunction  .7-  Jifera/  | Meraf  "a"  conjunction 

literal  .v-  True"  | T"  | pred-app  | T disjunction  T 

pred-app  name  arglist 

arglist  :.•»  T ar$*  V" 

arf  fun-app  \ variable  | constant 

fun-app  name  arfMif 

variable  identifier 

h-clause  foai  V subgoals  \ goal 

goal  pred-app 

subgoals  pred-app  [ pred-app ]* 

conjfanf  number  | jfrin/  | "frue"  | *<"  | */a/ie‘  | */" 

| "undef  | V T I quoted-const 

string  dbl quote  [ anychar  | punctuation  | dblquote  dblquote  | " " ]*  dblquote 
punctuation  V | V I I “ I V I V I T I T I V I T 
variable  identifier 
quoted-const  .v-  exp 

exp  .7-  identifier  | V e/em*  T 
e/em  constant  | variable  \ exp 
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LEXICON: 

number  .v-  inttgtr  | rtal 
inttgtr  .v-  digit-stq  I sign  digit-stq 

mantissa  .•.»  Inttgtr  digit*  I sign  *.*  digit-stq  | V (Ugit-stq 
rtal  mantissa  1 mantissa  V inugtr 

digit-stq  .v-  digit  digit* 

digit .v  0 | / 1 2 | S ! 4 | 5 | 6 | 7 | S | 9 

sign  .v  V"  I 

idtntifitr  .v-  anychar  \ anychar  idtntifitr 

where  anycha*  < {•,nlu,c.3,7-.+.-.*.&JI 

qtut,r>.yMifl.pAJ/df,gJijMxxt,v]>,n.mQ, 

and  dblquott  t { " ) 

S.2  Semantic}  of  the  Specification  Language 

The  semantic*  of  a function  specification: 

"function"  namt 
"input  pattern?"  input-patttrn 
"parameter  list?"  id-list 
"prtcond?"  precondition 
" postcond ?"  postcondition 

"body?"  h-claust*  V 

informally,  is  that  for  all  possible  instantiations  of  the  formal  parameter  list,  if  each 
parameter  designated  as  an  input  by  the  input  pattern  has  a value  bound  to  it  and  the 
value  of  the  precondition  evaluated  on  the  inputs  is  true  (i.e.,  the  Inputs  lie  within  the 
domain  of  definition  of  the  function),  then  the  conjunction  of  each  of  the  Horn 
clauses  and  the  postcondition  is  true.  Expressed  as  a formula  in  first  order  logic: 

VS  definedl  lnputs[S[id-/ift],  S[inpuf-p«ft#rn]]  ] a S [precondition] 
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S[A-c/aus«*]  a ((S[nam<]  &[id-list])  -»  &[postcondltLon]) 9 


where: 


the  semantic  function  S maps  elements  of  the  specification  language  onto  their 
denotations  in  first-order  logic.  Due  to  the  similarity  of  the  languages 
involved,  this  mapping  is  the  identity  mapping  for  the  id-list,  input- 
pattern,  and  name.  The  denotations  of  the  precondition  and  postcondition 
are  the  obvious  formulas  of  first-order  logic.  Elements  of  the  semantic 
domain  will  be  given  in  bold  type  whenever  a distinction  is  desired, 
x represents  all  variables  in  $[id-list) 

lnputs[S[i<f-/isO.  Slinput-pattern]]  is  the  list  of  input  parameters,  i.e.,  those 
parameters  in  corresponding  to  I’s  in  S [input-pattern) 

defined[u]  is  true  iff  every  element  of  the  list  u has  a value  that  is 
completely  defined  (contains  no  free  variables) 

S[A-c(auj**]  is  the  conjunction  of  the  semantics  of  the  individual  horn 
clauses.  The  semantics  of  each  horn-clause  is  that  for  all  variables 
mentioned,  the  conjunction  of  the  right-hand-side  implies  the 
left-hand-side. 

S[nam«  id-list ] is  the  denotation  of  the  application  of  S[nam<]  to  S[id-list)  in 
first-order  logic. 

For  example: 

function  Fact 

input  pattern f (JO) 

parameter  list T (x  y) 

precond?  Integer(x,  true)  a i(x,  0,  true). 

postcondl  lnteger(y,  true)  a >(y,  0,  true). 

body f Fact(0,  J) 

Fact(z,  u)  ► Subl(z,  zl),  Fact(zl,  wl),  *(*,  vl,  w). 

has  the  semantics  of  the  associated  first  order  logic  expression: 

Vx,y  [ defined[(x)]  a Integer(x,  true)  a a(x.  0.  true)  -» 

Fact(0, 1) 

a Vs,tl,w,wi  [ [SubKs.  tl)  a Fact(sl,  wl)  a *(»,  wl,  w)  •*  FactOu  w)) } 
a { Fact(x,  y)  -♦  Integer(y,  true)  a >{y,  0,  true) ) ) 

The  semantics  of  a type  specification: 

" type " name 
mbodyTm  h-clause*  V 

3We  assume  that  the  logical  operators  have  the  following  precedence 
relationships,  from  tightest  to  least  binding:  -,  a and  v,  •»,  ■ or  <->. 


■ A—. 
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Is  given  by  the  first  order  logic  formula: 

Vx  defined!  (x) ) -»  S[A-cf<iuse*] 

a [ S[nam<  (x,  y)\  •*  boolean(y.true)] 

The  antecedent  of  the  implication  guarantees  that  we  have  an  input  value,  the 
consequent  asserts  the  conjunction  of  the  Horn  clauses  making  up  its  body  and  the 
fact  that  the  result  of  a type  predicate  is  a truth  value.  The  precondition  is  "True" 
(and  therefore  need  not  even  appear  in  the  antecedent  of  the  implication)  since  we 
want  to  allow  anything  at  all  as  input  to  a type  predicate,  the  postcondition  need  not 
be  stated  explicitly  in  the  specification  since  it  is  always  the  same. 

The  semantics  of  a generic  function  specification  \ 

" generic " n ame 
" parameter  listf"  id-list 
" choices r 
input-pattern j 
" 'function  name?"  /unname, 

* precondf " precondition  ( 

" postcond?"  postcondition, 

' body-namef"  bodyname, 

input-pattern,, 

" function  name?"  funname„ 

"precondf"  precondition n 
“ postcond f"  postcondition „ 

" body-name f"  bodynamen 
" body-defs 

name,  "f"  h-clau.se*, 
name „ 7"  h-clause* k "." 

is  given  by  the  conjunction: 

A£,  Vx  I (S[f unname,  id-list ] -*  S[name  id-list ))  a 

(defined!  iiiputsISfirf-fisO-  Slinpur-paffrrnJ) ) a S[prrcondifion,]  -* 

SI  H-C[bodyname,)  ) a (S(/unnam<,  id-list)  -»  S[postcondltion J) ) ) 

4Note  again  that  the  subscripts  are  not  part  of  the  syntax 
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where: 


H-C[6odyna»Uj]  it  the  h-clause*,  associated  with  bodynamt, 

the  input-pattern's  are  distinct, 

the  funname's  are  distinct, 

the  bodynamt) s need  not  be  distinct, 

the  name)s  are  all  distinct  and  are  all  the  different  bodynamt, ‘i  listed  above, 
and  S is  the  identity  mapping  on  bodynamt'i  and  funname's. 

Thus  the  generic  specification  has  the  effect  of  defining  several  diferent  functions  and 

associating  them  all  with  a "generic"  name  that  can  be  used  when  one  does  not  wish  to 

bother  with  using  a different  name  every  time  the  function  is  called  In  a different 

way,  that  is,  with  a different  input-pattern. 

The  semantics  of  a target  definition  is  simply  the  ordinary  Hoare  rule  for 

assignment: 

P[name/target]  { target  name  } P 

Using  this  specification  language  we  can  describe  an  algorithm  for  unification  of 

two  lists  of  terms  as  follows: 

function  Unify 

input  pattern ? (I  1 0) 

parameter  list?  (tl  l2  s) 

precondition?  List(tl,  true)  a List(t2,  true). 

postcondition?  Substitutions,  true). 

body?  Unify(  ().(),()) 

Unify(  (),  cons(x,u),  undef) 

Unify(cons(x,u),  0.  undef) 

Unify(cons(x;l),  cons(y;2),  s)  *■  Unifytems(x,y,  si), 

Mk-subst(sl,  tl,  t2,  neuit l,  newt 2), 

Unifylnewtl,  newt2,  s2), 

Compost-subs(sl,  s2,  s). 
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Logic  Programming  versus  Synthesis 

Predicate  logic  can  be  viewed  as  a powerful,  high  level,  nondeterministic 
programming  language.  Why  not  simply  program  in  logic  instead  of  bothering  with  a 
system  to  obtain  programs  in  some  other  language?  For  one  thing,  logic  is  often  more 
powerful  than  we  need,  and  this  power  is  not  free.  The  full  backtracking  abilities 
required  by  an  implementation  of  logic  can  be  costly  in  time  and  space.  Also,  some 
languages  are  better  suited  to  particular  problems  than  are  others.  Although  the  style 
of  program  generated  by  the  system  proposed  here  is  inherited  from  the  specification 
and  therefore  similar  in  all  languages,  a program  transformation  system  may  be 

| 

constructed  that  could  optimize  programs  in  a specific  language  to  take  advantage  of 
its  special  features.  The  main  purpose  of  the  synthesis  system  is  to  see  that  we  end  up 
with  correct  programs.  In  this  section  we  look  at  logic  as  a programming  language, 
and  then  as  part  of  the  specification  language  for  this  system. 
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The  completeness  of  the  Horn  clause  subset  of  predicate  logic  as  a programming 
language  has  been  proven  by  Andreka  and  Nemeti  [AN  761.  The  operational 
semantics  has  been  found  [EK  74]  to  be  part  of  the  proof  theory  of  predicate  calculus 
and  thus  closely  related  to  the  axiomatic  semantics.  The  operational  semantics 
involves  consideration  of  all  possible  derivations  from  the  axioms.  This  implies, 
among  other  things,  the  ability  to  compute  relations,  not  just  functions.  For  example, 
the  operational  semantics  of  the  atomic  formula  Tlmts(x,y,  z),  would  be  described  as 
follows: 

(a,  b,  e)  < D0p[7m«]  iff  (a,  b,c)i{  (x, y,  z)  | h*  Timts(x, y,  z)) 

where  X is  the  theory  of  predicate  calculus  augmented  by  the  definitions  given  as 
axioms.  A computation  of  Times(3,  4,  x)  would  find  only  one  answer,  with  x-12. 
However,  a computation  of  Timts(x,y,  12)  would  involve  several  derivations:  Tima(l, 

12. 12) ,  Timu(12, 1, 12),  Timu(2,  6, 12).  Tl»us(6,  2. 12),  Tim*s(3,  4, 12),  and  Tlmts(4, 

3. 12) ,  (in  some  order).  The  computation  of  Timts(3,y,  z)  would  never  terminate  since 
there  are  an  infinte  number  of  derivations  possible. 

There  is  no  distinction  made  between  input  and  output.  A given  tuple  is  in  a 
particular  relation  or  not.  This  facet  of  logic  programming  is  particularly  useful  in 
data  base  applications  [E  78]. 

There  is  no  order  of  evaluation  implied  by  a logic  program.  Its  operational 


semantics  involve  all  derivations  without  indicating  which  should  be  attempted  first. 
Thus,  a logic  program,  together  with  a call  on  it,  determines  a computation  tree  but 
says  nothing  of  which  path  to  follow.  Under  these  circumstances,  to  prove  termination 
of  a logic  program,  one  must  prove  the  tree  is  finite. 
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In  any  given  implementation  of  a logic  interpreter  things  are  not  that  bad.  The 
order  of  evaluation  is  deterministic,  so  the  tree  is  always  traversed  in  a predictable 
way.  Even  so,  if  all  derivations  are  to  be  attempted,  termination  occurs  only  for  finite 
trees.  However,  termination  can  be  proved  under  some  circumstances..  For  example, 
if  only  a single  answer  rather  than  all  answers  is  desired,  then  one  may  be  able  to 
prove  termination  for  a particular  order  of  evaluation  with  respect  to  specific 
argument  positions  being  designated  for  inputs. 

In  the  current  system  we  have  chosen  to  define  functions  rather  than  relations,  in 
the  sense  that  we  want  a single  unique  answer  to  a question  rather  than  all  possible 
answers.  This  decision  is  based  on  the  belief  that  a programmer  knows  when  th* 
answer,  any  answer,  or  all  answers  to  a problem  is  desired  and  can  design  the  program 
to  ask  for  such  explicitly.  Asking  for  the  answer  "the  set  of  all  framices  that  foo’  is  a 
request  for  a single  unique  answer. 

The  specification  of  a function  includes  a Horn  clause  description.  The 
specification  is  translated  into  a deterministic  algorithm  expressed  in  an  intermediate 
language.  Currently,  clauses  are  tried  in  the  order  given  as  are  subgoals  within  a 
clause.  An  automatic  ordering  is  under  consideration  by  Mike  Franusich  at  the 
University  of  California  at  Santa  Cruz.  Some  analysis  can  be  done  to  ensure,  for 
example,  that  termination  cases  are  attempted  first,  and  subgoals  that  produce  values 
arc  called  before  other  subgoals  that  need  those  values  as  input 

We  distinguish  between  input  and  output  variables  for  two  reasons.  First,  given 
which  values  are  expected  to  be  available  and  which  are  to  be  computed,  we  can  often 


■ 
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prove  termination  when  in  the  general  case  we  may  not  be  able  to  (for  instance,  in  the 
Timtsfx,  y,  z)  example  discussed  earlier).  Also,  perhaps  more  importantly,  we  believe 
that  programs  tend  to  be  based  on  the  construction  of  the  variables  one  expects  to 
compute.  The  programmer  is  more  likely  to  see  a task  as  deriving  output  information 
from  given  input  information  than  as  a non-directional  exploration  of  the 
relationship  between  the  two.  Thus,  even  if  the  program  terminates  when  inputs  and 
outputs  are  interchanged,  the  computation  may  become  horribly  inefficient. 

Programs  can  be  written  that  are  "nicely"  invertible,  meaning  that  one  direction 

of  computation  is  about  as  efficient  as  another.  In  logic  programs  invertibility  is  more 

| 
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general  than  simply  swapping  of  input  and  output  variables;  we  are  dealing  with 
n-tuples  not  ordered  pairs.  Thus,  for  an  n-ary  predicate  there  are  2n  different  ways 
of  designating  input  and  output  variables.  Sickel  [$  78]  describes  j-invertibility, 
refering  to  the  jth  variable  of  the  n-tuple.  She  presents  some  guidelines  for 
constructing  invertible  functions,  and  describes  algorithms  to  test  the  invertibility  of 
programs. 

Since  it  can  often  be  useful  to  describe  one  procedure  that  may  be  used  in 
different  ways,  we  have  included  the  concept  of  a "generic  function" 5.  We  wish  to 

According  to  the  dictionary,  "generic"  means  "applicable  or  referring  to  all  the 
members  of  a genus  or  class".  A "generic"  function  is  mentioned  elsewhere  in  the 
literature  as  a function  whose  specific  form  is  determined  by  the  data  type  of  its 
arguments.  We  are  extending  this  notion  to  include  functions  whose  "input  patterns" 
(determining  which  formal  parameters  are  to  be  expected  as  input  when  a function  it 
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allow  the  convenience  of  invertible  functions  while  requiring  the  programmer  to  be 
aware  of  the  possibilities  in  the  program.  Thus,  we  require  that  ore  list  the  different 
calling  styles  by  input-pattern  and  indicate  a function  body  (set  of  Horn  clauses)  to  be 
used  in  each  case.  A predicate  with  six  different  (useful)  calling  styles  may  use  the 
same  logic  program  as  the  specification  for  three  input-patterns,  another  for  two 
input-patterns,  and  a third  for  the  last.  Thus  we  get  the  best  of  both  worlds;  we  know 
enough  to  maintain  the  guarantee  of  termination,  and  the  user  gains  the  flexibility 
afforded  by  a generic  function  in  the  specification  of  other  programs.  The  system 
attaches  a different  name  to  each  function  body  and  determines  from  context  which  is 
appropriate  in  a given  instance  of  the  generic. 


called)  may  vary.  The  implementation  of  the  generic  chosen  by  type  rather  than  input 
pattern  is  suggested  as  an  extension  of  the  current  system  . 
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Intermediate  Language 


The  intermediate  language  form  of  function  definitions  is  strictly  for  use  by  the 
system.  The  user  never  sees  or  programs  anything  in  the  internal  form.  The 
auxiliary  specifications  (all  but  body  specifications)  are  essentially  unchanged;  their 
representation  is  slightly  different  but  exactly  the  same  information  is  expressed. 
Thus,  the  only  really  interesting  part  of  the  intermediate  form  is  its  treatment  of  the 
body  specification. 

The  body  of  a function  in  internal  form  is  a "backtracking-conditional' 
("bktrkcond"  for  short).  The  name  is  slightly  too  general  as  only  a restricted,  well 
behaved,  kind  of  backtracking  is  allowed.  Each  clause  of  the  specification  becomes  an 
"alternative"  in  the  bktrkcond.  An  alternative  consists  of  a "match"-part,  which  is  an 
argument  list  to  be  matched  against  the  actual  parameters  of  a function  call,  and  a 
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"try”  part  consisting  of  the  subgoals  to  be  accomplished.  If  the  match-part  of  an 
alternative  is  accomplished,  then  the  actual  call  on  the  function  is  an  instantiation  of 
the  head  (or  goal)  part  of  the  clause  from  which  the  alternative  was  derived.  Thus, 
according  to  the  specifications,  we  can  assert  this  call  if  it  is  possible  to  accomplish  all 
the  subgoals.  If  the  match-part  succeeds  then  we  attempt  the  try-part  of  the 
alternative.  If  the  try-part  is  successful,  then  we  are  done;  if  not,  then  we  must  look 
for  another  alternative.  The  backtracking  involved  is  well-behaved  in  the  sense  that 
we  backtrack  only  over  entire  alternatives,  never  over  individual  subgoals  in  the 
try-part  of  an  alternative.  All  that  must  be  undone  is  the  bindings  made  in 
accomplishing  the  unification  of  the  actual  parameter  list  with  the  argument  list  in  the 
match-part  of  the  alternative. 

We  impose  determinism  on  the  program  at  this  stage  by  insisting  on  a particular 
order  for  considering  the  alternatives:  the  order  in  which  the  user  supplied  them  to 
the  system.  An  extension  to  the  system  is  desired  that  would  analyze  the  alternatives 
and  decide  for  Itself  what  order  would  be  most  effective.  The  ordering  of  the 
subgoals  is  also  open  to  question.  These  issues  are  being  investigated  by  M.  Franusich, 
a student  at  UCSC,  and  we  hope  to  incorporate  his  results  eventually. 

The  intermediate  form  of  a generic  specification  involves  two  things.  First,  the 
intermediate  form  of  a generic  definition  contains  only  the  parameter  list  of  the 
function  and  a list  associating  input-patterns  with  the  function  name  to  be  used  when 
that  input-pattern  is  recognized.  Although  it  does  not  appear  in  the  internal  generic 
definition,  a generic  specification  causes  the  function  definitions  for  each  alternative 
version  of  the  function  to  be  made. 
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The  Intermediate  Language  15  similar  to  the  Input  Language  in  many  ways.  To 
point  out  the  similarities,  we  have  used  the  same  nonterminal  names  where  applicable. 
All  the  nonterminals  are  prefixed  with  a "8“  to  distinguish  them  from  those  of  the 
Input  Language. 
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5.1  Syntax  of  Intermediate  Language 

A context-free  grammar  describing  the  Intermediate  Language  is: 
PHRASE  STRUCTURE: 

program  :.•»  S definition* 

Sdefinilion  Sfun-def  | Stype-def  | Sgen-def  | Starget-def 

Sfun-def  :.■*  ’(’  " function " Sname  Sinput-pattern  Sid-list 
S precondition  S postcondition  Sbody  ')" 

Stype-def V 'type"  Sname  “( 1 0)'  '(*  y)m  T"  •( boolean  y)m  Sbody  ')' 

Sgen-def  ,v»  "('  " generic " Sname  Sid-list  S selection * ")" 

Starget-def  .v-  '('  "setq"  " target ’ Star  get-language  ')' 

Star  get-language  .v-  Sname 
Sselection  .v-  Sinput-pattern  Sname 

Sinput-pattern  .v-  "('  Szero-or-one*  ’)" 

Szero-or-one  .v-  "O'  | T 
Sname  .v-  Sidentifier 

Sid-list  .v  V name*  T 
S precondition  ,v-  Sdisjunction 
S postcondition  .v»  Sdisjunction 

Sdisjunction  .v-  Sconjunction  | V "v*  Sconjunction  Sdisjunction  ')’ 
Sconjunction  Sliteral  | V "a"  Sliteral  Sconjunction  ')' 

Sliteral  .v»  T"  I Spred-app  | Sdisjunction 

Spred-app  .v-  Sname  Sarg*  ")" 

Sbody  .v-  Sbacktracking-conditional 
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S backtracking-conditional  .7-  '(“  "bktrkcond"  {alternatives  m)m 
{alternatives  /.-»  (match-try- pair* 

Smatch-try-pair  T (arglist  "(’  7rj"  (subgoals ')'  ’)" 

Sarglist  T Jarg*  T 

larg  S/un-app  1 ( variable  | f constant 

tfun-app  .•.»  7"  ln«mr  farg*  ')' 

tsubgoals  .t»  tpred-app * 

S variable  .7-  identifier 

S constant  c.--  number  | {string  | 7rm"  | */a(M*  | "undef  | "(*  T 1 1 quoted-const 
{string  .7-  V "string"  S char-list  ')' 

{ char-list  .•>  7"  [ anychar  \ {punctuation  \ dblquote  | " " ]*  ')' 

{punctuation  V | 7."  I I 7*"  I V I V I 7/’  I 7/"  | 7("  I 7)" 

{quoted-const  ,t»  7“  "quote"  iexp  ’)" 

texp  identifier  | 7"  tclcm*  ")" 
telem  {constant  | {variable  | irxp 


i 

t 
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The  LEXICON  it  the  tame  at  for  the  specification  language. 


5.2  Semantics  of  the  Intermediate  Language 


The  semantics  of  the  intermediate  language  form  of  a function  definition: 

tfun-def  .7-  7"  ’function"  (name  {input-pattern  Sid-list  t precondition 

( postcondition  {body  ")" 

it  given  by  the  first  order  logic  formula: 

Vx  dcfined[  lnputt[S[firf-fisr],  S[iinpuf-parrern]]  ] a S[lpr«on<firion]  -♦ 
S[l6o<fy]  a (S[Sinm<  t id-list ] -*  {[(postcondition)) 

where: 

the  semantic  function  S maps  elements  of  the  intermediate  language  onto  their 
denotations  in  first-order  logic.  This  is  the  obvious  mapping  for  (id-Ust, 
(input-pattern,  (name,  (precondition,  and  t postcondition . (see  page  25 
S represents  all  variables  in  S[lirf-/irO 
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lnputs[S[Sld-list],  &[i  input- pa  turn]}  is  the  list  of  input  parameters,  i.e., 

those  parameters  in  S[$id-list]  corresponding  to  l's  in  S [Sinput-patUrn] 
defined[l]  is  true  iff  every  element  of  the  list  I has  a value  that  is 
completely  defined  (contains  no  free  variables) 
and  the  semantics  of  the  function  body  S[$fro<ty]  is  given  below. 

The  intermediate  form  of  a function  body  is: 

V "bktrkcond"  T Sarglist  x T " try " S subgoals , ’)"  ")" 

V Sarglist „ "("  "try"  $subgoalsn  T m)m 

Informally,  the  semantics  can  be  expressed  as  a conjunction  of  implications  each  of 
which  states  that  if  the  values  bound  to  the  Sid-list  are  an  instantiation  of  Sarglist^ 
then  the  conjunction  of  all  the  subgoals  in  t subgoals,  implies  (Sname  Sarglist).  Of 
course  any  substitutions  necessary  to  unify  the  Sid-list  and  Sarglist,  must  be  made 
throughout  the  Ssubgoalsf 

We  actually  want  an  "ordered"  conjunction,  to  ensure  that  the  implications 
involved  In  each  alternative  are  considered  in  the  order  given.  We  want  to  say  that  if 
both  antecedents  in  the  implication  are  true  then  we  can  successfully  claim  the 
consequent  and  do  not  wish  to  consider  the  remaining  implications  as  applicable; 
however,  if  either  antecedent  is  false,  then  we  want  to  proceed  looking  for  an 
implication  that  is  "useful"  to  us. 

Let  us  represent  by  9,  the  substitution  applied  to  unify  6 Sarglist,  with  Sid-list, 
If  such  a unification  is  possible.  For  all  A,  Affj  is  A with  all  substitutions  in  made. 

‘Unification  is  the  process  of  finding  a "most  general  substitution",  in  the  sense 
of  making  as  few  bindings  as  possible,  which  will  render  the  objects  being  unified  to 
be  syntactically  identical.  See  [D  76],  or  [M  64]  for  a complete  definition. 


InUrm«dUt*  Unfutft  St 

Expressed  as  a formula  of  first  order  logic: 

A£|  [ (unifyIS[lirf-/tjO.  S[$ar£/i«j]]  « 9)  a Aj;}  (-b;)  -♦ 

( S[$  subgoals, 9]  •*  S[inam/  targllst,)?, ) ] 


where; 

S is  again  obvious  on  Sarglist's  and  t sub  goals'  s 
b;  stands  for  (unify[S[ii(f-/i;r],  S[iarg/iifj]]  • r)  a S[t  subgoals  pf] 
S[t  subgoals, 9,)  is  the  conjunction  of  all  subgoals  in  tsubgoals, 
with  the  substitution  9,  made  throughout, 
and  all  free  variables  are  universally  quantified. 


The  semantics  of  a type  definition  is.  again,  very  similar  to  that  of  a function 
definition.  The  semantics  of  the  type  definition: 

V ' typt " inamt  "(I  0)'  "(x  y)"  T"  '(boolton  y)m  tbody  ’)’ 
is  given  by  the  formula: 

Vx  defined^  (x)  ] -»  S[ii>od>]  a ((S[<namr  fx  y)])  *4  S[f6oo/#an  >)]) 
where  S[l6txfy]  is  as  defined  above  for  function  bodies. 

The  semantics  of  a generic  definition: 

T " gtntric " Sname  tid-list 

Sinput-patttrnj  Snamtj 

iinput-patttrnn  Snamtn  T 

is  given  through  an  association  of  a call  on  Snamt  with  the  Snamtj  determined  by  the 
positions  of  the  arguments  having  values  at  the  time  the  function  is  called.  Formally: 

A:,  Vx  [ 

S[def-of[lnam#J]  a (S[inam<,  tid-list ] -*  S[inam<  tid-list ])  ] 

where:  S(def-of[lnam/,]]  is  the  semantics  of  the  function  definition  of  titans 

i.e., 

Vx  defined!  inputs[S[fid-/ist],  S($inpur-parr<rn;]]  ] 

a S[Spncondition J -♦ 
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S[body*of[infl»i#,)]  a (S [Snamtl  tld-llsi ] ->  S[S postcondition^) 
The  semantics  of  a target  definition: 

T "setf  " target “ Snamt  “)" 
is  the  Hoare  rule  for  assignment: 


?[Snamtltargtt]  { (setq  target  Snamt)  J P 
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Mapping  From  Input  Specification  to  Intermediate  Form 


We  now  define  the  mapping  / (for  ’internalize”)  from  input  specifications  into 
intermediate  language.  In  the  first  column  we  identify  the  input  form  being 
translated,  the  center  column  shows  the  translation,  and  the  third  column  relates 
nonterminals  of  the  input  language  to  the  instance  being  translated.  Since  the  lexicon 
for  both  languages  is  the  same,  the  translation  is  concerned  only  with  the  phrase 
structure  of  the  languages. 

/[input]  ■ /[definition*]  input-definition* 

/[<]  - < where  < is  the  empty  string 

/[definition  i definition *]  • 

/[definition^  /[definition*] 


/[definition]  - /[fun-def] 
/[definition]  - /[type-def ] 


definition  - fun-def 
definition  - type-def 
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/[definition]  » 

/[gen-def] 

definition  - gen-def 

/[ definition ] - 

/[targtt-def] 

definition  - targot-dof 

/[fun-def]  • 

"( function " name  input-pattern 
id-list  /[precondition] 
/[postcondition] "("  ’ bktrkcond" 

l[ h-clause *]  ")"  ")" 

fun-def~'function"  name 
"input  pattern?"  input-pattern 
"parameter  list?"  id-list 

"precondf"  precondition 
" postcondf " postcondition 
"body?"  h-clause * 

The  function  / is  the  identity  mapping  on  name’s,  id-list's,  and  input-pattern's,  and  on 

precondition's  and  postconaition’s  it  is  simply  a translation  to  a fully  parenthesized 

prefix  form  of  representation. 

/[precondition ] - 

/[disjunction] 

precondition  - disjunction  " " 

t[ post  condition ] - 

/[disjunction] 

postcondition  - disjunction 

/[ disjunction ] - 

/[conjunction] 

disjunction  - conjunction 

/[ disjunction ] - 

"(  v"  /[conjunction] 
/[disjunction] ")" 

disjunction  « 

conjunction  "v"  disjunction 

/[conjunction]  » 

/[literal] 

conjunction  - iiferai 

/[conjunction]  > 

"(  a*  /[ literal] 

/[conjunction] ’)" 

conjunction  ■ 

/iterai  V conjunction 

/[literal ] ■ 

T" 

literal  - 

/[literal]  • 

m*pm 

/iterai  - T” 

/[litoral]  ■ 

/[pred-app] 

literal  • pred-app 

/[litoral]  ■ 

/[disjunction] 

literal  - T*  disjunction  ')" 

/[pred-app]  • 

/[name  trglist] 

pred-app  - /name  7argllst 

;The  internalized  form  of  a generic  application  will  have  a different  name 
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/[name  argils t ] - 

V name  /[arg*]  T 

arglist  - '('  arf  ')' 

/[ arg,  erg*]  - 

/[arg,]  l[arg*] 

/[arg]  - 

/[constant] 

arg  - constant 

/[arg]  - 

variable 

arg  - variable 

/[arg]  - 

/[fun-app] 

arg  - fun-app 

/[constant]  - 

number 

constant  - number 

/[constant]  - 

'('  'string'  /[string] ')' 

constant  - string 

/[constant]  • 

'true' 

constant  - 'true' 

/[constant]  - 

'true' 

constant  - “t" 

/[constant]  - 

'foist' 

constant  - "/e/se" 

/[constant]  - 

'falst' 

constant  - 7* 

/[constant]  - 

'undef 

constant  - 'undef 

/[constant]  • 

"f  Hjm 

constant - V T 

/[constant]  • 

/[ quoted-const ] 

constant  - quoted-const 

/[fun-app]  • 

/[name  arglisl] 

fun-app  • name  arglist 

/[string]  - 

'('  'string' 

/[  [anychar  \ punctuation 
| dblquott  dblquotc  | * "]*  ] 

string  - dblquott 
[anychar  \ punctuation 

')"  | dblquott  dblquott 

| " "]*  dblquott 

/[  [ anychar  | punctuation 

| dblquott  dblquott  )•"]*]• 

T [ /[anychar] 

| /[ punctuation ] 

substituted  Tor  the  name  of  the  generic  if  it  appears  in  the  specification  of  the  body  of 
a function.  This  is  why  we  listed  name  as  the  translate  of  /name  above.  The  name 
which  is  chosen  will  depend  on  the  input  pattern  of  the  function  being  specified. 
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| /[dblquott  dblquott ] 

|/t"'3J*  T 


fanychar)  • 

anychar 

K punctuation ] - 

punctuation 

punctuation  - 

N M | « M | MlM 

/[dblquott  dblquott ] 

■ dblquott 

1 1 ; 1 •• 

/[■  "3  - 

7 " 

llquottd-const]  • 

7"  ’quott"  l[txp] ")" 

quoted-const  - exp 

K**p)  • 

identifier 

exp  - identifier 

Htxp)  • 

V lltltm*]  “)" 

exp  - *f*  e/m*  "3" 

l[eltm  | tltm*]  m 

t[tltmx]  l[tltm*] 

l[elm ] • 

H constant 3 

e/em  - constant 

l[tlm]  m 

/tuar/eWr] 

tltm  m variablt 

Helm  3 - 

litxp) 

tltm  - exp 

/[variablt]  - 

identifier 

variablt  • identifier 

l[varlablt 3 - 

! identifier 

variable  - identifier 
formal  parameters  are 
indicated  by  a first 
character  "Is 

The  interesting  part  of  / maps  Horn  clauses  onto  the  intermediate  form  of  the 
function  body.  Whenever  an  instance  of  a generic  call  is  encountered  in  the  body  of  a 
specification,  the  first  version  of  the  generic  whose  input  pattern  is  satisfied,  i.e.  all 
argument  positions  corresponding  to  I’s  in  the  input  pattern  have  values  supplied,  is 
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substituted  for  the  generic.  Thus  we  never  have  to  translate  generic  specifications  into 
the  target  language;  we  just  translate  each  specific  version. 


/[ h-claust)  h-claust*]  - /[A-c/fluse,]  l[h-claust*] 
l[h-claust]  • /[goal] 

Kgoal]  - r arglist  V '‘try" ')'  V 


l[h-claust ] - ’(’  arglist 

V "try"  lisubgoals]  “)“  T 

/[subgoals]  ■ l[pr€<t-appi] 

/[[","  prtd-app]* ] 

/IV  prtd-app  ( 

prtd-app) *]  - llprtd-app;]  /[[","  prtd-app)*] 
For  type  specifications  we  have: 


h-claust  - goof 

goaf  - prtd-app 
- name  arg/tsf 

h-claust  - goaf  "►*  subgoals 
goal  - name  arg/ijf 

subgoals « 

prtd-app  i { V prtd-app 3* 


/[type-def]  - T "(yP*m  name  ’(' / 

■(*  yj*  T*  “(boolean  y t)“ 

T “bktrkcond"  llh-claust *]  T 


(ypt-dtf  - 
"type"  name 

"body?"  h-claust* 


As  discussed  earlier,  one  may  consider  the  type  definition  to  be  the  definition  of 
a predicate  to  recognize  instances  of  the  type.  We  must  make  a distinction  between  a 
type  definition  and  the  recognizer  for  a type  when  our  target  language  is  strongly 
typed.  This  will  be  discussed  in  the  mapping  from  intermediate  form  to  target 
language. 

The  mapping  from  the  input  specification  of  a generic  function  to  its 
intermediate  form  involves  not  only  the  internal  form  of  the  generic  definition  but 


m 
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alio  that  of  each  of  the  specific  version*  of  the  generic  being  defined.  The  function 
•Select  create*  a sequence  of  input-pattern  fnamt  pair*  from  which  the  choices  of 
individual  function*  to  *ub*titute  for  generic  calls  will  be  made.  The  function 
/WeAe-defe  create*  a function  definition  for  each  version  of  the  generic.  The 
resulting  definition*  are  identical  to  tho*e  that  would  have  been  created  if  each 
version  were  specified  explicitly  a*  a fun-dtf.  * 


l[gtn-def) 8 - 


" generic “ gname  id-list 

Soloctllchoict  "choicest”]*]  “)" 
M»k*-de>1  slid- list, 

[choice  ' choices? "]* 

bodydef *] 


gen-def  - 

" generic “ gname 
“parameter  list t"  id-list 

" choicest “ [choice  ' choicest"! * 
"body-def s'  body-def* 


where: 

Se/ect[«]  - * where  * is  the  empty  string 

Sa/acttchoice,  “choicest"  [choice  “choicest"]*]  - 

Selectlchoice^  Select[[choice  “choicest"?] 


S*l»ct[choice]  • input-pattern  f name  choice  - 

input-pattern 
“function  namef “ f name 
“ precondt “ precondition 
“ postcondt"  postcondition 
“body  namef “ bname 


M aka-da ftlid-listichoice  “choicest"]*, «]  - * 

M»k»~d»f*[ld-llst,e,  body-def*]  • t 

M*k»-daf*[id-list,  choice , * choicest “ [choice  ' choicest “f,  body-def *]  • 

*The  variable*  gname,  fname,  and  bname,  in  the  following,  are  all  instances 


the  nonterminal  name. 

•/[ gen-def]  it  of  the  form  Sgendef  Sfundef*  in  the  intermediate  language. 


of 
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Moko-dof[id-list,  choice  t,  Body~ot[cholceu  body-def* 11 
M»ko-dofo[id-list,  [choice  'choices?')*,  body-def] 


Bodyof[choice,  body-def  j - tht  body-def  whose  bname 

it  mentioned  in  choice. 


Mmkomdof[id-list,  choice,  body-dtf]  - 

■(" " function ' fname  choice  - 

in  put- pattern  id-list  precondition  input-pattern 

postcondition  l[h-clause *]  ')'  Junction  name?'  fname 

'precond?'  precondition 
m postcondT  postcondition 
' body  name?'  bname 
body-def  ■ 

bname  h-clause * 


Finally. 


Ktarget-def]  - '('  " setq ' ' target ' 

target-language  ")' 


target-def  ■ 

' target ’ target-language 


The  target  language  specification  is  just  information  to  the  system  indicating 

which  target  language  is  desired  and  is  of  interest  only  in  choosing  the  mapping  from 

intermediate  language  to  target. 

The  specification  of  the  factorial  function: 

function  Fact 

input  pattern ? (I  0) 

parameter  list?  (x  y) 

precond?  Jnttger(x,  true)  a i(x,  0,  true). 

postcond?  lnteger(y,  true)  a >(y,  0,  true). 

body?  Facl[0, 1) 

Fact(i,  x o)  - Subl(t,  tl).  Factfil,  oil),  *(t,  ml,  m). 


has  the  following  form  In  the  Intermediate  Language: 
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( function  Fact  (I  0 ) (lx  ly) 

(a  (Integer  lx  true ) (i  lx  0 true)) 

(a  (Integer  ly  true)  (>  lyO  true)) 
(bktrkcond  ((0  I)  (try)) 

((It  ho)  (try  (Sub!  It  It!) 
(Fact  hi  hoi) 

(*  h hoi  Ito)  ) ) 

)) 
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T~ 
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We  wish  to  show  that  the  semantics  of  an  input  specification  is  "sufficiently" 
preserved  in  the  mapping  to  intermediate  form.  By  "sufficiently"  we  mean  that  the 
semantics  of  the  intermediate  form  of  a function  definition  is  implied  by  the  semantics 
of  the  input  specification,  and  furthermore,  if  every  function  (or  type)  P is  defined 
such  that  for  each  input  tuple,  (i.e.,  tuple  with  which  the  function  is  called)  there 
exists  a unique  output  tuple,  x0,  such  that  P(x6)  is  derivable  using  the  input  semantics, 
then  P(x9)  is  derivable  using  the  semantics  of  the  intermediate  form  of  the  definition. 
We  refer  to  this  restriction  of  requiring  uniqueness  of  the  output  tuple  by  saying  that 
we  are  defining  only  "functional"  relationships. 

The  semantics  of  input  and  internal  form  are  not  equivalent  because  the  input 
semantics  may  be  used  several  ways  to  generate  proofs.  This  is  due  to  the 
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nondeterministic  nature  of  the  process  of  finding  proofs.  At  any  stage  of  a proof, 
there  may  be  many  Horn  clauses  that  are  applicable  as  axioms,  and  different  proof 
paths  may  generate  different  results.  However,  we  have  restricted  ourselves  to 
defining  functional  relationships  rather  than  the  more  general  "relations"  which  may 
be  onc-to-many  mappings.  Thus,  no  matter  what  direction  the  proof  takes,  there  Is  a 
unique  result.  If  a function  is  specified  chat  does  not  return  unique  answers,  then  the 
resulting  program  (and  any  others  whose  specifications  make  use  of  the  function)  will 
be  partially  correct;  however  we  cannot  guarantee  that  any  specification  using  such  a 
function  will  result  in  a program  that  always  finds  an  answer  when  one  exists. 

In  the  intermediate  form  we  are  forced  to  apply  the  Horn-clauses  in  a specific 
order.  Due  to  the  determinism  introduced  we  will  follow  precisely  one  proof,  the  same 
proof,  every  time  a procedure  gets  called  with  the  same  input  values.  The  important 
point  to  establish  is  that  whenever  a unique  answer  may  be  found  in  the 
nondeterministic  proof  process,  our  deterministic  search  will  find  it  as  well.  First,  we 
establish  two  lemmas. 

Lemma  1.1 

Vx  S[A-ciauK*)  -♦  $[l[h-clausi*]] 

that  is 
Vx  ( 

A£,  (name  arglistj  ► &[suigoals,])  -* 

A" 

'Vi 

(unify [id-list,  arglist,]  • e,)  a A'. ]l*'(S[/[ju6£oa/;l]tf'j])  -* 

(SMsuigoa/rJe,]  -»  S[/[nami  argtijfJeJ)  ] 

where  Vx  stands  for  the  universal  quantification  of  all  variables  mentioned  in  the 
quantified  formula. 
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Proof: 

We  shall  show  that  for  each  i,  S[A-tlause]  -»  S[/[A-c/ai«#]].  For 
the  sake  of  readability  we  shall  leave  out  the  quantifier  with  the 
understanding  that  all  variables  are  universally  quantified.  Thus, 
we  want  to  show: 

(name  arglist*  ► S [subgoals,))  -* 

( (unif y [id-list,  arglist,)  • 9 ) a 
A*j  m'(S[l[subgocl s i)9 (])  -♦ 

(S(/[su6goa/Si]ff  J -»  S(/[namr  arg/ist,]*,]) ) 


• * . 


1.  S[ju6goa/jj]  -»  name  arglist,  hypothesis 

2.  [S[iu6goflfj(]  -♦  name  arglist*]**  Vx  A(x)  I-  A(t) 

(as  many  times  as  necessary,  given 
that  we  change  variable  names  that 
are  introduced  by  the  substitution 
in  order  to  ensure  that  the  new 
variables  are  fra  for 10  the  old. 

t.  (S[/[su6goc/s,]]  -♦  S[/[nam<  arg/ijr,]]]*,  from  2.,  equivalent  replacement, 

and  the  facts  that 

S[/[juigoa/;,]]  ■ S[ju6goflisJ 

and  S[l[name  arglist,]]  m S(namr  arglist,] 

4.  Sl/[iubgoals,]9']  -*  S[/[nam#  arglist ,))9,  property  of  substitution 


S.  (unify [id-list,  arglist,]  ■ 9)  A -* 

a /y.]l-'S[/[sufcgoa/jJ]<rj] 

-*  (S[/[subgoals,]9,]  -*  S[/[nam«  arglist, ]]9) 


A -♦  (B  -*  A)  and  4.,  and  Modus  Ponens 


Deduction  Theorem,  1..S. 


6.  (name  arglistj  *•  S[;uigoai;,])  -* 

( (unify [id-list,  arglist,]  ■ 9)  a 
A£|  ->S[/[suigoafs,]ffj]  -♦ 

(SlUsubgoalSt ]*,]  -*  S[/[nam<  arglist, ]o,]) ) 


,0For  a formal  definition  of  frit  for  see  Davis  [D  761  Kleene  [K  621 
or  Mendelson  [M  641 
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The  following  lemma  makes  use  of  two  sub-lemmas  whose  proofs  follow  it. 

Lemma  1.2 

Vx  (Y  -*  Y')  H Vx (X  •*  Y a Z)  -♦  Vx(X  -►  Y'  a Z) 
where  X.  Y,  Y',and  Z are  any  well-formed-formulas.  The  proof  is  given  for  a single 
quantified  variable.  Clearly  it  can  be  generalised  to  any  number  of  variables. 

1.  Vx(X  -*  Y a Z)  hypothesis 

2.  Vx(X  -♦  Y)  1..  Lemma  1.2.1 

S.  X -*  Y 2..  V-elimination 


4.  Vx(Y  - Y') 

5.  Y -*  Y# 

6.  X -*  Y* 

7.  Vx(X  -»  Y*) 

8.  Vx(X  -*  Z) 

9.  Vx(X  -*Y'aZ) 


hypothesis 

4..  V-elimination 
M-.  transitivity  of  •* 

6..  V-introduction 

1..  Lemma  L2.1 

7..  8..  Lemma  1.2.2 


9.  Vx(X  -»  Y a Z)  -*  Vx(X  •*  Y'  a Z)  1.9..  Deduction  Theorem 


Lemma  1.2.1 

Vx(X  Y a Z)  I*  Vx(X  -*  Y) 

we  will  derive  the  above  version,  and  by  commutativity  of  a assume  that  we  also  have 

Vx(X-*YaZ)I-  Vx(X  •*  Z) 


1.  Vx(X  iYaZ) 

2.  X -•  Y a Z 
t.  X 

4.  Y aZ 
t.  Y 

6. X-*Y 

7.  Vx(X  -*  Y) 


hypothesis 

V-elimination 

hypothesis 

2.J..  Modus  Ponens 

A-elimination 

5.. 5..  Deduction  Theorem 

8.,  V-introductlon 


Lemma  1.2.2 


Vx(X  -*  Y).  VxfX  -»  Z)  K Vx(X  iYaZ) 
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! 


I 


1.  Vu(X  -» Y) 

2.  X •*  Y 

I.  Vx(X  -•  Z) 

4.  X-*Z 

5. X 
S.  Y 

7.  Z 

8.  Y aZ 

9.  X -o  Y a Z 

10.  Vx(X  -♦  Y a Z) 


hypothesis 

1.,  V-elimlnation 
hypothesis 

5.,  V-elimination 
hypothesis 

2.. 5.,  Modus  Ponens 

4..  5.,  Modus  Ponens 
A-introduction 

5.. 8.,  Deduction  Theorem 
V-introduction 


We  are  now  in  a position  to  prove  our  first  theorem. 


Theorem  1 1 


S[/ItnpuO]  •- P(x)  •>  S[lnpu<]  H P(S) 


Any  proof  derived  from  the  semantics  of  the  intermediate  form  could  be  derived 


from  the  semantics  of  the  input  specification.  We  will  show  this  by  determining  that 


the  semantics  of  an  input  specification  implies  the  semantics  of  the  intermediate  form 


of  the  specification. 


Proof: 


Since  input  is  a sequence  of  definitions  which  gets  internalised  as  a 


sequence  of  definitions,  we  shall  show  that: 

S[de/inifton]  -♦  S[t[dtfinltion\] 


Then  the  con  junction  of  the  input  definitions  implies  the  conjunction  of 


the  intermediate  language  form  of  those  definitions  and: 

S[tnpuf]  -♦  S[f[inpMf]] 


and  thus  anything  derivable  from  S[/linpufJ]  can  be  derived  from  S[input] 


by  first  deriving  SMinpuf]]  and  then  following  the  same  proof.  We  must 


establish  two  things: 1 1 


'Recall  that  / Is  Just  the  identity  mapping  on  id-list a,  input-pattern's, 


and  name’s. 


t . *• 
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1)  for  function  and  type  definition* ,a: 

[ Vx  defined!  inpuu[S[W-«ff].  S'jnpuf-paffrrn]] ] a Slprtcondition] 

•4  S[lt-elaus**]  a ( (S[nam<)  Sltd-Zist])  -*  S [port condition])  ] 

■4 

[ Vx  defined!  inputs[5[irf-/»f].  S[mput-patttrn]]  ] a $I/Ipr«endi/ien] 

■*  SI/tA-c/euf#*]]  a ( (S[nam«)  S[id-iiit])  -♦  S[/[poifcondifion])  ] 

2)  for  generic  definitions: 

VS{ 

(S(/unnam*i  id-list]  •*  S[nam<  id-list])  a 
( defined!  input*!S[id-H«].  S(input-partrrn,]]  ] a SlprrconditionJ 

•*  S[H-C[tody-nomt,]]  a {S(/unnam<j  id-list]  -*  St  postcondition^ ) ] 

-* 

A:,  Vx  t 

(S[funnamt,  id-list]  •*  S[namt  id-list ])  a 
( defined!  inputs[$(Irf-/«f],  S[input-p<w«rnj]  ] a S[l[prta  fionj]] 

-♦  Sti[H-C[fcody-namr,]]]  a (S [funnanu,  id-list]  -»  S[/lpv*fcondificnJ]) ) ] 

where  H*C[6ody-nomc,]  is  the  h-claust*  associated  with  body-naimr 

1)  is  of  the  form  Vx  (A  a B -#  C a D)  -*  Vx  (A  a B V a D),  where 
we  know  by  Lemma  1.1  that  Vx(C  -*  C').  Thus,  this  is  just  an  instance  of 
Lemma  1.2  with  *A  a B"  for  X.  *C"  for  Y.  XT  for  Y',  and  "D*  for  Z. 

2)  for  each  i,  is  of  the  form  Vx[(A  -*  B)  a (C  a D -*  E a F)]  •*  VS{(A  •* 
B)a(CaDiE'a  F)].  This  is  just  XaYiXaY',  where  we  know  by 
part  I)  that  Y -»  Y*.  For  each  1,  the  statement  is  true,  thus  the  conjunction 
of  statements  over  all  i’s  is  true. 


12The  semantics  of  a type  definition  is  the  tame  as  that  for  a function 
definition.  We  gave  them  separately  before,  pointing  out  that  we  know  what  the 
id-list,  input-pattern,  precondition,  and  postcondition  are  for  type  definitions. 
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Theorem  2> 

If  each  definition  is  functional  with  respect  to  its  output  variables,  that  is,  if  for 
each  function  or  type  P and  each  input  tuple  Xj,  there  exists  a unique  output  tuple,  So, 
such  that  P(£o),  then: 

S[inpur]  I-  P(Xo)  •>  S[/[inpu/]]  i-  P(x0 ) 

Proof. 

Given  a proof  of  P(x)  from  $[inpuf]  we  can  construct  a proof  from 
S[f[tnpu(]].  A clause  of  the  definition  of  P is  applicable  if  and  only  if  the 
current  goal  Is  an  instance  of  the  head  of  the  clause,  i.e.,  there  is  a such 
that  unify[id*list,  arglistj  ■ where  id-list  is  bound  to  the  actual 
parameters  in  the  goal.  Thus  the  only  time  when  a clause  that  is 
applicable  in  the  proof  from  S[inpuf]  may  not  be  used  in  a proof  from 
$[/[inpur]]  is  when  there  is  a previously  listed  clause  that  is  also  applicable. 

Suppose  the  proof  of  P(x)  makes  use  of  the  clause  Pj  of  the  definition 
of  P when  there  is  a clause  Pj,  j<i,  that  is  also  applicable.  Our  proof  from 
S[f[input]]  will  attempt  to  prove  P(x)  using  P,.  We  are  guaranteed 
termination  of  this  attempt  by  the  precondition.  If  we  ^terminate 
successfully,  we  will  have  proved  P(x),  since  this  proof  may  also  be 
considered  a proof  from  S[inpur]  and  we  have  assumed  that  S is  unique. 

If  we  terminate  unsuccessfully,  then  we  will  attempt  another  clause,  possibly 
Pi  now,  as  in  the  original  proof  from  S[fnpur],  or  possibly  some  Pk,  J<k<i. 

We  will  eventually  succeed  before  attempting  Pj,  or  we  will  use  Pj  as  we  did 
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in  the  original  proof.  The  same  analysis  is  applicable  to  every  clause  used 
in  the  proof  of  P(X)  from  $[inpur]  and  thus  we  can  derive  P(S)  from 

QJ.D 
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Mapping  the  Intermediate  Language  to  LISP 


We  have  chosen  to  use  LISP  as  the  first  target  language.  One  may  find 
documentation  for  the  version  we  use,  MACLISP,  in  [M  741  We  generate  "pure 
LISP"  programs,  using  none  of  the  special  features  of  the  MACLISP  implementation, 
however  the  names  of  the  primitive  functions  may  vary  from  implementation  to 
implementation.  These  functions  include:  defun,  for  defining  a function,  putprop,  for 
putting  a property  on  the  property  list  of  an  atom,  and  get,  for  getting  a property  from 
the  property  list.  The  function  L.  mapping  the  intermediate  language  into  LISP  is 
defined  as  follows. 


L[t  definition  \ tdefinition*] 


L[S definition J i 
USdefinitlon J < 


HSfun-def] 

U$type-d«f] 


Ht definition i)  Ut definition *] 
t definition  • Sfun-def 
S definition  • Stype-def 
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USfun-def)  ■ "(put prop”  "'Sname 

"'Sinput-pattern  "inpat)' 

'( putprop * ml' Snamt  "'Sid-llst 


Sfun-def  • 

'('  'function*  Sname 
Sinput-battern 
t id-list  $ precondition 


*’params)*  Sld-llst  S precondition 

'(putprop'  "' tname  '"S precondition  S postcondition  '(' 

"precond)'  'bktrkconcT  Salternatlves  ')'  ')' 

'(putprop*  ’"Sname  '"$  postcondition 
*’ postcond )' 

'(defun'  Sname  'fexpr  (l)' 

'(bktrkcond  l* '" Solternatives '))' 


Utype-def]  ■ '(putprop'  "'Sname  type-def  - 

"(I  0)  ‘inpat)'  '(’  'type'  Sname 

'(putprop  '"Sname  "(x  y)'  '(l  0)'  '(x  y)' 

"params)"  T*  '( boolean  y)' 

'(putprop  "'Sname  '(' ' bktrkconcT 

"T  * precond )’  Salternatlves  ')'  ')' 

'( putprop  "’Sname 
"(boolean  y)  ’postcond)" 

'(defun’  Sname  "fexpr  (l)' 

'(bktrkcond  l "' Salternatlves "))' 


There  it  no  mapping  of  generic  definitions,  only  of  the  specific  function 
definitions  involved,  and  these  are  identical  to  that  for  fun-def%  above.  The  LISP 
function  bktrkcond  evaluates  its  arguments,  binds  the  results  to  the  formal  parameters 
actuals  and  list-alts,  and  then  recursively  attempu  each  alternative  until  an  answer  is 
found  or  all  alternatives  have  failed,  indicating  that  the  answer  is  undefined.  The 
complete  set  of  definitions  of  LISP  functions  that  implement  the  mapping,  i.e. 
definitions  for  bktrkcond,  match,  try,  and  all  of  the  subfunctions  required,  may  be 
found  in  Section  16.1,  beginning  at  page  162. 

The  LISP  program  that  is  generated  from  the  specification  for  the  factorial 
function  is  as  follows.  The  list  of  putprop'%  get  evaluated  only  once,  they  represent 
global  information  about  the  properties  of  the  function.  The  defun  is  the  actual  LISP 


definition  of  the  function. 
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(dtfun  Factftxpr  ( l ) 

(cond  ((Irut-prtcond  (corn  ‘Fact  0) 

(bktrkcond  l 

V(0  J)  (try)) 

((!x  !y) 

(try  (Subl  !x  Ixl) 

(Fact  !xl  !yl) 

(*  lx  lyl  ly)))))) 


(t  ’undtf))) 


Correctness  of  the  Mapping  to  LISP  Program 


We  shall  show  that  the  semantics  of  the  LISP  form  of  a function  or  type 
definition  is  equivalent  to  the  semantics  of  the  intermediate  form  of  a function  or  type 
definition.  There  is  no  distinction  between  function  and  type  definitions  in  either 


We  have  shown  earlier  that  the  semantics  of  the  intermediate  form  of  a 


definition  is  expressed: 


VS  defined!  inputs[$id-list,  Sinput-pattern]  ] a (precondition 


(unify[$id-list,  SarglistJ  ■ v) 
a Aj;{  (unify [Sid-list.  targlistj] • *\-* 

-*  ( S[Ssu£foafSjff  J -»  ((name  Sarglistj)^ ) ] 

A 

VS  Sname  (id-list  -» (postcondition 
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Since  Sarglist,  and  Sid-list  are  unified  by  9„  we  can  use  $name  Sid-list  instead 
of  Snaine  Sarglistj  in  the  final  consequent  of  the  first  conjunct  above.  Another  way 
of  expressing  the  fact  that  Snaine  Sid-list  is  true  is  by  saying  that  Sid-list  < Snaine, 
that  is,  the  given  tuple  is  an  element  of  the  relation  Snaine.  Before  turning  our 
attention  to  the  semantics  of  the  LISP  form,  we  shall  rewrite  the  semantics  of  the 
intermediate  form  in  such  a way  as  to  facilitate  our  proof.  This  rewriting  is  based  on 
several  rules  of  first-order  logic.  To  make  the  statements  more  readable,  we  shall  look 
at  the  general  form  of  the  rewrite  first,  and  then  apply  the  result  to  the  expression 
above. 

We  are  going  to  focus  our  attention  on  the  first  conjunct  of  the  above 

expression.  This  is  of  the  form: 

Vx  A -*  A£,  [B  a C -♦  (D  -»  E)j 
which  is  equivalent  to 

Vx  A -*  Vi  [B  a C -*  (D  -♦  E)] 

where  actually  the  quantifier  on  i is  bounded.  Since  we  know  there  are  a finite 
number  of  i's  we  will  not  put  in  the  bounds.  It  should  be  understood  that  i ranges 
over  the  number  of  clauses  given  in  the  definition. 13  The  above  statement  is  in  turn 
equivalent  to 

Vx  A -♦  Vi  [(B  a C a D)  -♦  E] 

Since  in  our  original  formula  E does  not  contain  any  free  occurrences  of  i,  this  is 
equivalent  to: 

VS  A [3i(B  aCaD)iE] 

l3The  "variable*  i is  not  really  a variable  at  all  in  the  formal  sense;  it  is  merely 
an  index.  We  could  write  out  the  consequence  of  the  above  implication  as  the 
conjunction  of  the  indexed  statements.  We  are  using  the  "Vi”  notation  because  it 
provides  a convenient  abbreviation. 


t 


■ 


i 
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Thus  our  new  formulation  of  the  semantics  of  the  intermediate  form  of  a 
function  (or  type)  definition  is: 


Vx  defined!  inputs[Sid-list.  {input-pattern]  ] a {precondition  -> 

[ 3i  ( unify[Sid-list,  Sarglist,]  • <r, 

a Ap|  (unify[$id-list,  Sarglistj]  ■ *j  -*  -'S[{su&go«(ij*j]) 
a StfsubgoalsfJ  ) 

•*  (Sid-list)*  j ( {name)  ] 

a 

Vx  ({id-list  < {name)  -»  {postcondition 

The  semantics  of  a LISP  form  of  a definition,  such  as: 

(putprop  Sname  Sinput-pattem  ’inpat) 

(put prop  Sname  Sid-list  ’params) 

(putprop  Sname  S precondition  ' precond ) 

(putprop  Sname  S postcondition  ’ postcond ) 

(defun  Sname  fexpr  ( l ) 

(tond  ((true-precond  (cons  Sname  l)) 

(bktrkcond  l (rest  Sbody-def))) 

(t  unde/))) 
it: 

Vx  [ eval[(cons  {name  actuals)} « * a,  a * undef  •*  (actuals)*  < Sname  ] 
a Vx[  (actuals  < Sname)  -*  {postcondition] 

where:  * is  a substitution  or  * - undef 
actuals  is  an  instantiation  of  Sid-list 
Sbody-def  is  (bktrkcond  (Sarglist\  (cons  'try  Ssubgools\)) 

(Sarglist2  (cons  ’try  Ssubgoals2)) 

(Sarglistn  (cons  ’try  S sub  goals  n))) 

The  actual  function  definition  begins  with  defun,  the  preceding  putprop’ t 
simply  attach  the  listed  information  to  the  property  list  of  the  function  being  defined. 
See  [MT  79]  for  a formal  axiomatization  of  the  semantics  of  LISP.  Using  the 
definitions  of  eval  and  {name,  we  can  write: 

eval[(cons  Sname  actuals)]  • 

IF  true-precond[(cons  {name  actuals)] 

THEN  bktrkcond[actuals,  rest  [Sbody-def]] 


\ 


i 
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ELSE  undef 


thus, 


ev»l[(con*  Sname  actual*)]  ■ » a #*  undef 
is  equivalent  to 

true*precond[(cons  Sname  actuals)]  a bktrkcond[actuals,  rest[Sbody*def]]  a r 

a ot  undef 

So  we  can  rewrite  the  semantics  of  the  LISP  form  as: 

VS  [ true*precond[(cons  Snaine  actuals)] 

a bktrkcondfactuals,  ((Sargli*t|  (con*  'try  Ssubgoali))) 

(Sarglist2  (cons  'try  Ssubgoals2)) 

••• 

(Sarglistn  (com  'try  SsubgoaUn)))]  ■ c 

a o 4 undef 

-*  (actuals)#  < Snaine  ] 
a Vx  [(actuals  < Snaine)  -*  Spostcondition] 

We  need  to  establish  that  the  above  statement  is  equivalent  to  the  statement  of 

the  semantics  of  the  intermediate  form  of  definition  given  above.  We  intend  to  show 

this  by  first  establishing  that: 

Vxt 

[deflned[inputs[$id-list,  Sinput-pattern]]  a Sprecondition]  -» 

[ 31  ( unify[Sid-list,  SarglistJ  ■ r, 

A AH,  (unify[Sid-list.  Sarglist,]  • r , -S[t  subgoals 

a S[Ssubgoals,r,]  ) 

-*  (Sid-list)#,  < Sname)  ] 

■ 

[ true-precond[(con*  Sname  actuals)] 

a bktrkcond[actuals,  ((Sarglist,  (cons  'try  Ssubgoalsi)) 

(Sarglist2  (cons  'try  Ssubgoali*)) 

(Sarglistn  (cons  'try  Ssubgoals*)))}  ■ r 

a##  undef 

-» (actuals)#  < Sname  ] ] 

The  expression  resulting  from  distributing  the  VS  over  the  equivalence  follows  easily 
from  this  stronger  result  First  of  all,  we  will  simplify  the  notation.  Both  Sid-list  in  the 
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intermediate  form  and  actual*  in  the  Lisp  form  are  names  used  to  refer  to 
instantiations  of  the  formal  parameter  list.  Since  these  are  now  within  the  scope  of  the 
same  universal  quantifier,  we  shall  identify  them  both  by  the  same  name,  actuals.  We 
should  also  mention  that  precondition  and  postcondition  are  names  that  are  being 
used  to  stand  for  the  formulas  they  represent.  Each  involves  some  of  the  elements  of 
the  formal  parameter  list  and  we  shall  assume  that  there  is  no  confusion  as  to  the 
bindings  of  these  variables  even  though  we  do  not  mention  them  explicitly  in  the 
formula. 

Before  attempting  the  main  theorem  of  this  section,  we  need  four  lemmas: 

1.  deflned[inputs[actuals,  Sinput-pattern]]  a {precondition 

■ true-precond[(cons  {name  actuals)) 

2.  unify[actuals.  Sarglistj  * 

a matclifactuals,  newver*ion[Sarglistj]]  ■ e,  a * undef 

3.  S[Ssubgoals)  a try[Ssubgoals]  ■ e a e * undef 

4.  3i  ( unify [Sid>list.  Sarglistj  ■ r, 

a A£j  (unify [Sid-list.  Sarglistj  ■ -»  -S[S sub goal J;r  J) 

a S[S  subgoals,*,  J) 

a 

bktrkcond[actual$,  ((Sarglistj  (cons  'try  SsubgoalsJ) 

(Sarglistj  (cons  'try  $subgoals2)) 

(Sarglistn  (cons  'try  SsubgoalsJ))]  • e 

Are  undef 

We  intend  to  show  that  the  top  level  mapping  is  correct,  however  we  do  not 
intend  to  prove  the  entire  implementation  correct,  so  the  proofs  of  these  lemmas  will 
be  informal  and  assume  correctness  of  several  subfunctions  involved. 


Lemma  1 

def!ned[input*[actua!s,  Sinput-pattern]}  a Spre condition 
a true-precond[(con*  {name  actuals)] 


Proof: 


> 


J 


r 


: 


i 

! 
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The  function  true-precond:  1)  looks  up  the  (input-pattern  associated 
with  Snaine  and  checks  to  see  that  all  input  positions  of  actuals  have 
values  supplied;  then  2)looks  up  the  (id-list  and  (precondition  associated 
with  Snaine,  binds  the  variables  in  Sid-list  to  the  values  supplied  by 
actuals  and  evaluates  the  (precondition.  Thus,  true-precond  returns 
'true*  if  and  only  if  both  steps  1)  and  2)  are  successful,  i.e.,  if  and  only  If 
defined[inputs[actuals,  (input-pattern]]  a (precondition. 

Lemma  2 

unify[actuals,  (arglist,]  ■ <r, 

■ match[actuals,  newversion[(arglistj]]  ■ 9t  a 9-  8 undef 

Proof: 

The  semantic  function  unify,  attempts  to  unify  its  arguments  after 
renaming  variables  so  its  arguments  have  no  variable  in  common.  If 
unification  is  possible,  then  unify  returns  a substitution,  if  not,  then 
unify[actuals,  (arglist,]  * 9 for  any  substitution  9,  so  the  result  is  false. 

newversion[(arglist]  generates  a new  version  of  (arglist  in  which  each 
variable  has  been  replaced  by  a newly  generated  one.  Thus,  newversion 
ensures  that  the  arguments  to  match  have  been  standardized  apart  match 
is  a unification  algorithm  that  returns  a (most  general)  substitution  9 if  its 
arguments  are  unifiable  by  9,  and  returns  undef  if  unification  Is  not 
possible.  Thus, 

unify[actuais,  (arglist,]  ■ 9 i 

m 

matchfactuals,  newversion[(arglist|]]  ■ #,  a r,  g undef 

QJED 
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Lemma  3 

S [tsubgoals]  m try[$*ubgoals]  • a a 9 •>  undef 

Proof: 

Each  subgoal  is  a function  application  P(xl,...,xn)  that  is  true  if  and 
only  if  the  precondition  on  the  input  arguments  is  true  and  there  exists  a 
substitution  r such  that  (xU..xn)e  is  the  unique  output  tuple  associated 
with  (xlH..Jtn)  by  P.  For  the  conjunction  of  a list  of  subgoals  to  be  true, 
each  must  be  true,  and,  since  all  their  variables  are  bound  by  the  same 
universal  quantifier,  a value  supplied  to  a variable  in  the  evaluation  of 
one  subgoal  is  propagated  to  all  occurrences  of  that  variable  throughout 
the  list  of  subgoals.  Thus,  juigoafj]  is  true  if  and  only  if  there  exists  a 
substitution  # such  that  subgosl,*  a subgoal2r  a ...  a subgoalAr. 

All  of  this  is  implicit  in  the  semantics  of  the  intermediate  form,  simply 
a property  of  bound  variables.  The  LISP  form  makes  it  all  explicit  by 
requiring  that  evaluation  of  P(xL..,xn)  ■ a where  * is  the  substitution 
such  that  (xlr..,xny  is  the  unique  tuple  associated  with  (xl,...xn)  by  P.  If 
there  does  not  exist  any  such  substitution  then  try  returns  undef. 

try[($subgoal  |t  •••»  $subgoalA)]  ■ 

IF  eval[$subgoal|]  • t a t * undef 

a trylmk-substftSsubgoal*. ....  SsubgoalJ,  ■ r* 
a »'  * undef 

THEN 
ELSE  undef 

Note  that  since  substitutions  are  made  as  you  go,  and  evaluations  that 
cause  binding  to  variables  always  create  new  variables  to  bind  to,  we  know 
that  Vx  such  that  # contains  a binding,  say  x/a,  there  does  not  exist  in  r 
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any  binding  of  (he  form  x/y  where  yea,  or  any  binding  of  the  form  y It 

where  i contains  x.  Thus, 

S [Ssubgoalt]  ■ try[$*ubgoals]  ■ e a 9 4 undef. 

QJ.D 
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A recursive  definition  of  the  form: 
f{u]  ■ IF  nu)i(u]  THEN  undef 

ELSE  IF  P[first[u]]  THEN  g[first[u]] 

ELSE  f[r»t[u]] 

has  the  property  that,  if  u ■ (u,  u2  ■■■  u„),  then 
f(uj  ■ s a a 4 undef  ■ 

3i(  g[uj  • a a a ¥ undef  a P[uJ  a (AH,  •*P[uJ]) ) 

This  is  a direct  consequence  of  the  definition  of  f,  which  specifies  chat  each 
element  of  u is  tested  in  the  order  given,  and  that  no  element  is  tested  unless  all  before 
it  in  the  list  have  been  tried  and  have  failed.  We  prove  it  by  induction  on  the  length 
of  the  list  u. 

Basis:  u • (u,) 

f[(u,)]  • IF  nuil[(u,)]  THEN  undef 

ELSE  IF  P[u,]  THEN  g[u,J 
ELSE  f[0] 

• IF  false  THEN  undef 

ELSE  IF  P[u,]  THEN  g[u,] 

ELSE  IF  null[0]  THEN  undef 
ELSE ... 

• IF  P(u,]  THEN  g[u,]  " 

ELSE  undef 

Thus,  f((U|)]  • a a a * undef  ■ P(u,]  a g[u ,]  ■ a a a * undef 

Induction  Step:  Assume  that  for  all  lists  of  length  i n: 
f[u]  ■ a a a * undef  ■ 

3i(  g[uj  ■ a a a «*  undef  a P[uJ  a ri)  -P[u,]) ) 


n(M|  ...  U(n,  |))]  • 

IF  null[(u,  ...u^i,)]  THEN  undef 
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« 

■ 


ELSE  IF  P[U|]  THEN  g[u,] 

ELSE  f[(li2  ...  U(n«l))] 

• 

IF  false  THEN  undef 
ELSE  IF  P[U|)  THEN  g(u,] 

ELSE  f[(u2  •••  U(r*.i>)] 

■ 

IF  P[u |]  THEN  g[u )] 

ELSE  f((u2  ...  U(rv.l,)] 

thus,  f[(u  | ...  u(nt|))]  ■ a a a a undef 

a 

(P[U|]  a g[u,]  ■ a a a * undef) 

v (-P£u,J  a f[(u2 ...  U(lv,|)))  ■ a a a * undef) 

a 

(M  a g[uj  • a a a * undef  a P[uJ  a (A^ijoj  hJ  -P[uj])  ) 
v (— Pfu  a 3i(  g[uj  • a a a a undef  a P[uJ  a (At*.ija{  j>t)  •’PfuJ))) 

a 

3i(  g[uj  • a a a o undef  a P[uJ  a (AkiJOj  Hi  -»P£«*3))) 

Q£D 


Lemma  4 

31  ( unify£Sid-list.  Sarglist,]  • 9, 

a A£|  (unifyCSid-list.  Sarglistj]  ■ -♦  -'S[lfuigotf/j(#)]) 

a S[$  sub  goals, * ft  ) 

■ 

bktrkcond[actuals,  ((Sarglist  t (cons  'try  SsubgoaU))) 

(Sargiistj  (cons  'try  SsubgoaU*)) 

••• 

(Sarglist,,  (cons  'try  Ssubgoals*)))]  ■ e 
a 9 a undef 

proof: 

Let  Salternatives  ■ ((Sarglist)  (cons  'try  SsubgoaU))) 

($arglist2  (cons  'try  Ssubgoals2)) 

••• 

(Sarglist*  (cons  'try  SsubgoaU*))) 
then,  bktrkcond[actuaU,  Salternatives]  ■ 

IF  null[Salternatives]  THEN  undef 

ELSE  IF  match[actualt,  newversion[SarglMt|]]  • r(  a r,  a undef 
a try[$subgoalist|*|]  ■ a r ,*  a undef 

THEN  cleanup!*  )•*)',  actuaU] 

ELSE  bktrkcond[actuaU,  ((Sarglist2  cons('try  SsubgoaU 2]) 

••• 

(Sarglist*  consftry  SsubgoaU*]))] 
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thus,  by  Subleinms  4.1 

bktrkcond[actuaU,  ((Sarglist,  (cons  ’try  Ssubgoals,)) 

(Sarglistj  (cons  'try  Ssubgoals2)) 

oaa 

($arglistn  (cons  'try  Ssubgoals,)))]  ■ 9 

a » * undef 

■ 

3i  match[actuals,  newversion(Sarglisti]]  ■ »,  a r,  * undef 
a try[$subgoali*tjPj]  • 9*  a 9 / 4 undef 
Ari  cleanup^,**;',  actuals]  a 9 4 undef 
A£j  -(inatch[actuals.newversio»i[SargJlst(]]  ■*, 
a 9j  4 undef  a (trylSsubgoallstjOj]  ■ 
a Oj'  * undef) ) 

■ 

31  match[actuals,  newversion[Sarglistj]]  a r,  a #,  4 undef 
a tryJSsubgoalist.Pj]  ■ 9*  a 9' 4 undef 
a 9 m cleanup!*,**/,  actuals]  a 94  undef 
Aj;{  ( (match[actuals.newver*ion[Sarglistj]]  •*, 

a *,  * undef)  *♦  -(try[Ssubgoallst,*,]  ■ *,' 
a *,'  # undef) ) 


by  Lemma  2 we  know 
unlfy[actuals,  Sarglist,]  • *, 

■ match[actuals,  newversion[Sarglist,]]  • *,  a *,  4 undef 
by  Lemma  S,  we  have 

S[Ssubfoals ] ■ trylSsubgoals]  • 9 a * 4 undef 
thus,  we  have 


31  ( unlfy[Sid-list,  Sarglist,]  ■ 9, 

A Apj  (u nlf y [Sid-list.  Sarglist,]  ■ *,  -*  ->S[liuigo«/i,*,]) 
A AfcubgoalistX  ) 

■ 

bktrkcond[actuals,  ((Sarglist,  (cons  'try  Ssubgoals,)) 
($argllst2  (cons  'try  Ssubgoals;)) 


(Sarglist,  (cons  'try  Ssubgoals,))))  a 9 
a 94  undef 


QJ&D 


THEOREM  (Correctness  of  LISP  form) 

VS  defined!  lnputs[Sid-llst,  Sinput-pattern]  ] a Sprecondltlon  -» 


Correctness  of  Mm  Miffiaf  to  1>UP  Prograa  W 


[ 3i  ( unify[Sid-list,  Sarglist,]  ■ a, 

a A£{  (unify[Sid-li*t.  Sarglistj]  • •*  *S[t  subgoals 

a S[t  subgoal: ,a{] ) 

-*  ($id*li»t)pj  ( Sname)  ] 

A 

VS  [(Sid-Ilst  < (name)  -*  Spostcondition] 


VS  [ true*precond[(cons  Sname  actuals)] 

a bktrkcond[actuals,  ((Sarglist)  (cons  'try  Ssubgoals()) 
(Sarglist  8 (cons  'try  Ssubgoals2)) 


(SarglistA  (cons  'try  SsubgoalsJ))]  ■ # 

a v 4 undef 

->  (actuals)*  < Sname  ) 
a VS  ((actuals  < Sname)  -»  Spostcondition] 

Proof: 

The  proof  has  actually  all  been  accomplished  through  the  lemmas.  We 
take  it  as  obvious  that  the  second  conjunct  of  the  first  expression  is 
equivalent  to  the  second  conjunct  of  the  second  expression.  Lemmas  I and 
4 supply  the  necessary  parts  to  put  together  the  equivalence  of  the  first 
conjuncts  of  each  expression. 


f+r'-* 
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variable  bindings  are  simply  a side  effect  of  the  computation,  which  is  the  way  it 
happens  in  logic  anyway.  If  one  wanted  to  stay  close  to  logic,  all  functions  would  be 
implemented  as  boolean  functions.  Once  a strategy  has  been  decided  upon  the 
following  functions/procedures  should  be  implemented.  All  of  these  definitions  are  to 
reside  in  the  target  language  system  except  for  maktjlanguagt  namt)~dtf  and 
autopred.  These  two  functions  are  meant  to  be  added  to  the  program  generation 
system.  The  only  change  to  be  made  in  the  system  is  in  the  function  translate.  For 
type-free  languages,  the  clause  ((tq  targtt ’ languagt ) ( maktJanguagtjdtf ))  is  added; 
for  typed  languages,  the  clause  ((tq  targtt  ' languagt ) (mk-strong-typtd) 
( maktJanguagtjdtf))  is  added. 

I.  Primitives: 

The  functions  and  predicates  listed  here  are  labeled  "primitives''  because  we 
assume  they  need  not  be  further  defined.  The  set  of  primitives  given  here  is  neither 
minimal  nor  exhaustive,  Just  convenient.  One's  target  language  may  supply  more 
than  these,  or  less. 

If  one  supplies  more  primitive  types  for  a strong-typed  language,  then  the  system 
must  be  informed  of  those  type  names.  This  may  be  accomplished  by  type 
specifications  with  empty  bodies,  i.e.  when  asked  for  the  body  part  of  the  specification, 
simply  type  a period.  Note  that  this  is  only  for  type  definitions,  and  only  for 
strongly-typed  languages.  For  type-free  target-languages,  and  for  all  other  function 
definitions,  if  one  wishes  to  make  use  of  a function  or  predicate  already  defined  in  the 
target  language,  then  one  should  use  the  mtf  or  "xp*  facility  (see  page  82). 
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If  a target  language  is  unable  to  supply  some  of  the  following  primitives,  one 
may  still  use  the  system,  but  should  not  make  use  of  those  undefined  primitives  in  any 
specifications. 

a.  Predicates  - primitive  predicates  do  not  have  an  output  variable. 

They  are  defined  in  the  target  language  such  that  they  always  take 
true  or  false  as  value,  in  type-free  languages,  and,  if  the  language  is 
typed  then  they  must  either  be  primitive  or  defined  types  in  that 
language.  Occurrences  of  these  type  predicates  in  preconditions  and 
postconditions  will  simply  become  declarations  in  a typed 
target-language. 

Integer(x) 

Real(x) 

Boolean(x) 

Is-String(x) 

Is-List(x) 

binary  relational  predicates:  -,  *,  >,  <,  i,  i 
(I/O):  Firstsym(x  y z)  - meaning  y is  the  first  symbol,  i.e.token, 
of  x,  leaving  z.  H 

Firstexp(x  y z)  - meaning  y is  the  first  expression  on  x, 
leaving  z.  where 

expression  constant  | variable  |"("  expression*  T 
Write(x)  - has  the  value  true  for  all  x,  and  has  the  side 
effect  of  printing  the  value  of  x on  the  current  output 
device. 

b.  Functions  - these  are  functions  whose  application  to  arguments  result 

in  terms.  Thus,  they  do  not  carry  output  variables.  The 
predicate-ized  version  of  any  of  these  (see  page  82)  is  obtained  by 
preceding  the  name  with  "if" 

(Integer):  +,  -,  *,  /,  rem 
(Real):  r+,  r-,  r#,  r / 

(Boolean):  a.  v,  - 

(String):  string(l)-makes  a string  out  of  a list  of  characters 
s-cat(sl  s2)  - string  concatenation 
s-cons(c  t)  - adds  a character  to  the  front  of  a string 

l4The  specification  of  the  system  is  done  in  such  a way  that 
Flrstsymfx,  y,  x)  could  simply  be  implemented  as  a scanner  which  gets  the 
first  token  of  input,  binds  it  to  y,  and  ignores  x and  z.  Firusym  with  three 
arguments  indicates  unlimited  backtracking  abilities  over  input  Since  this  is 
not  always  implementable  in  one's  target  language,  one  must  use  the  general 
form  Judiciously.  Similarly  with  Finttxp. 


V - * " , 


Adding  • New  Target  Language  7 8 


firstch(s)  - gets  the  first  character  of  a string 
tail(s)  - rest  of  a string  (without  first  character) 
mk-string(e)  - makes  a string  of  a single  character 
(List):  first(i)  - gets  first  element  of  a list  I 

rest(l)  - gets  the  list  1 without  the  first  element 
cons(x  I)  - adds  x to  front  of  list  I 
list(x  1 ...  xn)  - creates  a list  with  elements  x I ...  xn 

c Constants  - the  grammar  for  the  intermediate  form  describes  the 
constants  of  the  system,  and  of  course  any  mapping  to  another 
language  must  be  able  to  recognize  constants.  The  reason  we 
mention  them  here  specifically,  is  that  we  have  included  at  least  one 
constant  that  is  not  universally  available  in  typical  programming 
languages.  This  constant  is  of  course  undef.  It  may  not  be 
convenient  (or  even  possible)  to  introduce  such  a constant  in 
strongly  typed  languages.  However,  the  purpose  of  unde/,  i.e.,  some 
way  of  indicating  that  we  have  determined  that  a well-defined 
value  in  the  appropriate  domain  does  not  exist,  should  be 
implemented.  More  is  said  about  this  in  the  section  on 
implementing  strongly-typed  languages. 

2.  The  following  functions  must  also  be  implemented.  The  first,  maktjlanguagt 
namt)_def,  should  be  an  actual  function  or  procedure  name.  The  others  are 
indicative  of  what  needs  to  be  accomplished.  They  need  not  exist  as  explicitly  defined 
functions.  For  example,  the  target  language  does  not  need  to  have  a procedure  named 
bktrkcond,  however,  the  function  of  bktrkcond,  i.e.,  the  selection  of  alternatives  to 
attempt  in  order  to  complete  a computation,  must  be  accomplished  by  some  means. 

a.  maktjlanguagt  namt).dtf  - This  function  has  available  all  the 
information  of  the  intermediate  language  definition.  It  creates  the 
target  language  definition,  i.e.,  the  actual  syntax  of  a procedure 
declaration/definition  in  the  target  language. 

b.  bktrkcond  - This  function  may  be  accomplished  as  an  ordinary 
conditional,  allowing  several  options,  or  as  a sequence  of 
IF-THEN-ELSE's  with  added  conditions  to  ensure  completion  of 
only  one  alternative. 

1)  undtf  - A distinguishable  bottom  element  of  every 
type  is  used  as  an  undefined  element.  Languages 
that  are  strong-typed  without  the  ability  to  add  a 
single  element  to  an  existing  type  cause  trouble 
here.  In  these  cases,  a variable  undtf  may  be 
used  which  is  local  to  each  bktrkcond  and  passed 
through  to  try. 


\ 
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c.  match  - The  pattern  match  may  simply  be  a unification  algorithm;  a 

more  general  matcher  will  allow  more  complicated  input  to  the 
matcher,  and  thus  enhance  the  system's  efficiency  if  done  well.  A 
simple  unification  algorithm  is  guaranteed  to  be  correct,  but 
requires  that  one  must  only  desire  syntactic  matching.  That  is,  the 
matcher  would  not  be  able  handle  the  unification  of  any  data  types 
that  have  more  than  one  representation. 

d.  try  - The  function  try  attempts  to  complete  the  computation  of  a list 

of  procedure  calls.  If  any  call  is  unsuccessful,  then  try  fails,  and 
another  alternative  is  selected  by  bktrkcond. 

e.  a precondition  checker  - This  may  be  implemented  as  a type  check 

and/or  first  condition  of  the  procedure  body,  governing  the 
execution  of  the  rest  of  the  body. 

Each  of  the  functions  mentioned  above  may  require  several  subfunctions.  For 
example,  in  a typed  language  one  would  probably  split  maktjlanguagt  namt)jdtf 
into  sub-parts  such  as  makt^dtc^part  and  maktJbody_part.  One  also  needs  to  check 
whether  the  lexicon  of  the  intermediate  language  is  compatible  with  the  lexicon  of  the 
target  language,  and  provide  a mapping  from  one  to  the  other  if  they  are  not.  Of 
particular  concern  here  is  the  fact  that  the  autoprtd  facility  allows  identifiers  whose 
first  characters  are  the  symbol  1 and  the  internalized  form  of  the  formal  parameters 
are  identifiers  with  first  symbol  T. 

3.  Define  autoprtd  to  allow  use  of  language-system-defined  functions  and  procedures 
(see  page  82).  Also  helps  in  the  automatic  predicating  of  the  primitive  *f unctions" 
mentioned  in  step  1. 


10.1  Implementation  Strategy  for  LISP 


The  definitions  of  the  primitives  for  LISP  are  given  in  Section  16.1,  beginning 
on  page  156.  The  choice  of  an  implementation  strategy  was  changed  after  seeing  the 
results  in  the  first  implementation  of  LISP.  We  discuss  this  here  since  it  the  lesson 
learned  in  the  process  may  be  applicable  to  several  languages. 
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Every  function  call  In  most  implementations  of  LISP  returns  a single  value.  19 
Thus,  In  the  original  implementation  it  was  thought  that  to  be  consistent  with  LISP 
every  function  call  should  return  the  value  of  its  output  variable.  This  decision 
seemed  quite  natural  at  first,  in  fact  it  seemed  the  only  way  to  be  compatible  with 
ordinary  LISP. 

No  problems  arose  as  long  as  the  functions  being  defined  had  precisely  one 
output  variable.  It  somehow  seemed  reasonable  to  expect  that  one  should  only  want  to 
compute  a single  value  when  dealing  with  a language  in  which  that  is  the  norm. 
However,  when  faced  with  a function  having  two  or  more  output  variables,  one  had 
to  choose  which  was  to  be  the  value  returned.  The  arbitrary  choice  was  made  that  the 
first  output  variable  would  carry  the  value  returned  by  the  function  call.  Although 
somewhat  dissatisfying  this  choice  caused  no  major  pro!  terns,  immediately. 

The  point  at  which  the  strategy  was  found  to  be  inadequate  came  when 
implementing  the  propagation  of  the  values  of  the  output  variables  to  the  rest  of  the 
current  list  of  subgoals.  It  was  certainly  possible  to  do  this,  but  it  was  not  pretty. 

A new  strategy  was  chosen.  Each  function  call  would  return  a substitution. 
This  strategy  is  completely  compatible  with  LISP  in  that  a substitution  is  indeed  a 
single  value.  It  was  still  easy  to  automatically  generate  "predicate-lied"  versions  of 
LISP-system  functions. 

The  new  implementation  turned  out  to  be  much  cleaner  and  more  amenable  to 


,9See  Anatomy  of  LISP  [A  78]  for  a discussion  of  an  implementation  of  LISP 


with  multiple-valued  functions. 
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proof  than  the  old.  The  lesson  to  be  learned  from  this  is  that  there  are  usually  many 
possible  choices  of  implementation  strategy,  one  should  not  feel  stuck  with  the  first 
choice,  and  one  should  not  overly  restrict  the  implementation  by  avoiding  what  may  at 
face  value  appear  to  be  an  extension  of  the  target  language,  but  in  fact  is  not. 


5 


* 
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10.2  Implementation  of  Pascal 

In  any  typed  language,  some  additional  information  about  the  types  of 
parameters  and  local  variables  is  desired,  and  it  is  convenient  to  generate  this 
information  once  and  keep  it  where  one  can  continually  reference  it.  When  it  is 
recognized  that  a program  is  to  be  generated  in  a strongly  typed  language  we  add 
more  information  to  the  property  list  of  the  function  being  defined. 

A list  of  the  formal  parameters  and  their  types  is  put  under  the  property  typts. 
These  types  are  gleaned  from  the  precondition  and  postcondition  specifications.  The 
remainders  of  the  precondition  and  postcondition  (i.e.  that  which  is  in  addition  to 
type  specifications)  are  listed  on  the  typtdprtcond  and  typtdpottcond  properties  of  the 
function. 

The  body  of  the  function  is  searched  to  determine  the  names  of  all  functions 
that  are  called  by  the  function  being  defined,  and  this  list  of  names  is  stored  under  the 
txttrnal-proes  property.  A list  of  the  local  variables  and  their  types  is  generated  and 
stored  under  the  local-dta  property.  When  an  external  declaration  is  made  for  a 
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function,  it  is  also  kept  so  that  the  same  declaration  need  not  be  derived  again  for 
every  other  function  that  calls  it. 

In  Pascal,  a function  or  type  specification  is  implemented  as  a boolean  function 
with  value  parameters  corresponding  to  the  input  parameters  and  var  parameters 
corresponding  to  the  output  parameters.  A function  will  return  the  value  trut  if  it  is 
successful  and  foist  if  it  is  not.  All  user-defined  types  are  treated  as  one  type,  and 
functions  are  generated  to  distinguish  among  them. 

If  one  wishes  to  translate  to  Pascal,  or  any  strongly  typed  language,  part  of  the 
precondition  must  be  a type  specification  for  each  input  parameter,  and  part  of  the 
postcondition  must  be  a type  specification  for  each  output  parameter.  This  means  that 
there  may  be  some  specifications  that  are  legal  input  to  the  system  that  will  not  be 
translatable  into  Pascal. 

The  necessary  additions  to  the  system  for  implementing  Pascal  as  a target 
language  may  be  found  m Section  16.2,  page  172.  Appendix  A,  which  contains 
several  sample  specifications  and  their  translations  into  LISP  programs,  exhibits  only 
one  generated  Pascal  program.  This  is  due  to  the  extreme  ugliness  of  the 
implementation  of  the  "back  end"  for  Pascal.  To  satisfy  the  type  restrictions  of  Pascal 
we  had  to  either  disallow  user-defined  types  or  map  all  types  to  a general  type  (we 
used  "term*).  Mapping  all  types  to  one  results  in  a very  general  structure.  This 
structure  is  nice  theoretically  in  its  universality,  but  unwieldy  in  practice.  We  felt  the 
point  could  be  shown  by  exhibiting  the  translation  of  the  factorial  function.  The  full 
generality  of  the  structure  Is  used  even  for  this  simple  example,  and  we  are  unable  to 
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The  top  level  of  the  system  is  called  "top"  and  is  called  by  typing  ’(top)"  to 
MACLSP.  Wher.  the  program  is  initialised  it  prompts  the  user  suggesting  that  if 
help  is  needed  one  should  type  *?'.  This  results  in  instructions  for  input  specifications. 
The  system  prompts  the  user  for  individual  parts  of  a specification,  and  again  a ”?" 
response  will  provide  information  about  the  required  specification,  along  with  an 
example. 

When  the  user  terminates  a session,  by  typing  at  the  top  level,  the  system  asks 
if  one  wishes  to  save  the  definitions  of  the  session  on  a file,  and  asks  for  a filename  if 
the  answer  is  affirmative.  Before  terminating  the  session,  the  system  informs  the  user 
how  to  include  the  definitions  Just  saved  the  next  time  the  system  is  started. 

The  pattern-matcher  plays  an  important  part  in  the  computation  of  programs. 
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Alternatives  in  the  backtracking-conditional  are  chosen  by  matching  the  actual 
parameter  list  against  a pattern.  A straight  unification  algorithm  is  easy  to  implement 
but  not  always  as  powerful  as  we  would  like.  It  works  well  where  there  is  a unique 
representation  of  the  objects  we  are  trying  to  match.  If  one  chooses  to  define  a data 
type  in  which  the  representation  for  each  element  is  not  unique,  then  one  should  also 
define  an  equality  predicate  "Equality  pt*"  for  the  type,  and  if  one  desires  more  than 
syntactic  matching  to  occur,  a function  'Equal-bind-<typt>m  that  will  attempt  to  match 
two  elements  of  the  type.  All  other  equality  testing  and  matching  is  done  syntactically. 

For  example,  if  one  chose  to  represent  sets  as  unordered  constructions  rather 
than  imposing  some  order,  one  might  provide  the  following  specifications: 
typt  Stt 

body?  Stt(Mt~stt,  trut) 

Stt(  Add~tltm(y,X),  trut)  *-  Stt(X,  trut),  Mtmbtr(y,  X,  foist). 
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function  Equal-stt 
input-patttrn?  (110) 
paramtttr-Ust?  (x  y z) 
prtcondition?  Stt(x,  trut)  a Stt(y,  trut). 
postcondition?  Booltan(z,  trut). 
body? 

Equal-stt(x,  y,  trut ) ► 5ubstt(x,  y,  trut),  Substt(y,  x,  (rut). 

Of  course, " Substf  and  ’ Mtmbtr " must  also  be  defined. 

Note  the  use  of  foist  in  the  second  clause  of  the  specification  of  the  body  of  Stt. 
Negation  of  predicates  is  not  allowed  by  the  syntax  of  Horn  clauses;  using  a 
truth-valued  output  variable  we  are  able  to  incorporate  negative  tests  into  the 
language.  In  the  definition  of  Mtmbtr  we  would  have  a clause:  Mtmbtrfx,  (),  foist)  «- 
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The  trtu  or  falsi  used  as  an  argument  of  a predicate  must  be  considered  a 
constant  (or  0-ary  function  symbol)  not  a predicate.  When  using  the  constant 
predicate,  TRUE  or  T,  we  distinguish  it  here  by  capitalization.  The  user  should  be 
aware  of  the  distinction,  however,  it  is  not  necessary  to  communicate  it  to  the  system 
through  capitalization  since  the  distinction  can  be  determined  by  context. 

Failure  to  find  an  answer  will  cause  the  value  undif  to  be  returned.  This  is  an 
indication  that  the  answer  is  undefined  either  because  we  attempted  to  apply  a 
predicate  to  arguments  no:  in  its  domain  (as  specified  by  the  precondition)  or  we 
failed  to  match  on  all  of  the  clauses  of  the  definition.  Returning  undif  will  fail  the 
subgoal  it  is  returned  to  and  thus  fail  the  current  clause  and  the  next  alternative  will 
be  attempted.  At  this  level,  undif  is  denoting  failure  to  successfully  terminate  a 
computation. 

At  another  level,  undif  is  a constant  that  is  assumed  to  be  in  every  domain.  It  is 
possible  that  one  might  call  a subgoal  with  the  constant  undif  in  an  output  variable 
position;  in  this  case,  if  undif  is  the  value  that  would  be  bound  to  that  position,  then 
the  subgoal  will  succeed.  There  are  times  when  undif  it  the  appropriate  answer  to  be 
returned  from  a function.  For  example,  if  one  defines  a look-up  function  that  takes  a 
name  and  a list  of  name-value  pairs,  and  returns  the  value  associated  with  the  name, 
then  one  would  expect  an  output  value  undif  if  the  name  does  not  occur  in  the  list. 

The  system  will  provide  default  values  for  the  parameter-list,  precondition,  and 
postcondition  of  the  specification  of  a function  as  it  does  for  a type  specification.  This 
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makes  the  Input  of  specifications  easier  but  is  not  recommended  for  general  use.  Even 
when  specifying  a program  that  is  only  expected  to  be  partially  correct,  one  should  be 
able  to  provide  a precondition  that  would  at  least  keep  some  bad  inputs  from  being 
accepted. 

A further  convenience  for  the  user,  the  system  will  automatically  "predicate-ize" 
functions  that  are  pre-defined  in  the  target-language  system.  The  user  Indicates  such 
functions  to  the  synthesis  system  by  prefixing  the  name  of  a function  with  "If"  and 
the  name  of  a system  predicate  (boolean  valued  function)  with  "ip".  An  output 
variable  is  added  to  the  argument  list  and  the  new  predicate  may  be  used  as  any 
other.  For  example,  the  recursive  clause  for  the  definition  of  factorial: 

faet(x,  y)  «-  tfsubl(x,  xl),fact(xl,  yl),  lf*(x,  yl,  y) 
makes  use  of  the  system  functions  "subl“  and  V.  Again,  since  these  are  being  defined 
automatically,  the  preconditions  are  simply  'true*,  so  the  only  type  checking  done  will 
be  that  provided  by  the  target  language.  We  do  not  guarantee  correctness  for 
definitions  made  in  terms  of  system  functions. 

The  mapping  to  a strongly-typed  language  requires  that  more  detail  be  spelled 
out.  When  the  system  recognizes  that  the  target  language  requires  explicit  declaration 
of  types,  it  derives  from  the  specifications  some  additional  properties  that  will  be 
useful  in  the  translation.  These  include  a list  of  formal  parameters  associated  with 
their  types,  a list  of  local  variables  and  their  types,  and  a list  of  all  functions  that  are 
called  by  the  one  being  specified. 
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Conclusions  and  Further  Research 


We  have  shown,  through  proofs  of  the  correctness  of  the  mappings  involved, 
that  the  system  described  in  this  document  provides  a valid  way  of  generating  correct 
programs.  The  system  works  by  adding  control  information  to  the  logic  that  is 
specified  by  the  user.  The  user  is  still  left  with  the  task  of  inventing  the 
computational  logic  description  of  the  program  desired.  We  feel  that  this  is 
reasonable  and  an  advance  in  the  process  of  obtaining  a correct  program  since  the 
programmer  is  no  longer  burdened  with  the  problem  of  describing  the  flow  of  control 
of  the  program. 

The  system  as  described  is  'reasonably"  target-language-independent.  We 
qualify  this  statement  only  because  it  is  easier  to  translate  to  some  languages  than  to 
others.  For  ease  of  translation,  the  target  language  should  allow  recursion.  The 
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"back-end”  neceuary  to  translate  to  a non-recursive  language,  although  certainly 
feasible,  would  be  more  complicated  than  that  for  a language  allowing  recursion  due 
to  the  necessity  of  translating  recursive  algorithms.  We  feel  this  is  almost  no 
restriction  at  all  since  we  believe  that  recursion  is  important  enough  to  be  a minimum 
requirement  for  any  language  to  be  considered  "reasonable". 

The  type  structure  of  a target  language  is  an  important  factor  in  determining  the 
ease  of  its  addition  to  the  system.  The  simplest  languages  to  deal  with  are  those  that 
are  type-free,  allowing  type  specifications  to  be  translated  into  functions  that  are 
recognlxers  for  the  type  being  defined.  In  a typed  language,  one  often  feels  the  need 
(or  desire)  for  polymorphic  functions  as  allowed  by  LCF.  LCF  checks  the  consistency 
of  types  without  insisting  on  knowing  precisely  the  type  of  every  object  at  compile 
time.  For  example,  one  can  define  the  function  compost,  which  takes  two  arguments  of 
functional  types  and  returns  a value  of  functional  type.  The  type  assigned  to  compost 
by  LCF  is:(Ctype2  -*  type3]  X [type!  -» type2])  •»  [type  1 •*  typeSl  A simple  example  of 
another  function  that  is  by  nature  polymorphic  Is  a symbol  table  lookup.  The  type  of 
the  result  of  a lookup  should  agree  with  the  type  of  the  variable  the  function  is  called 
with.  However,  there  may  be  several  different  types  of  variables  and  values  in  the 
table  at  any  time. 

The  use  of  generic  functions  in  the  specifications  is  a new  feature  making  it 
possible  to  synthesise  several  programs  from  a single  specification.  Generic  functions 
also  provide  a convenient  tool  in  defining  other  functions.  The  portability  of  the 


Several  sample  programs  have  been  generated,  many  are  listed  In  Appendix  A. 

Several  extensions  to  the  system  and  subjects  of  further  research  have  suggested 
themselves  along  the  way.  We  divide  these  loosely  according  to  whether  they  deal 
with  the  front-end  of  the  system,  the  present  capabilities  of  the  system,  or  the 
back-end  required  to  add  a new  language. 

We  would  like  to  add  a front-end  to  the  system  that  would  allow  more  natural 
input.  This  includes  several  extensions  of  the  syntax  of  the  specification  language. 
First,  the  use  of  embedded  function  applications  cuts  down  on  the  amount  of  typing 
necessary.  We  can  trivially  make  use  of  function  applications  that  have  only  a single 
output  variable  by  a simple  syntactic  manipulation  that  replaces  the  occurrence  of 
these  in  argument  positions  by  a temporary  variable  and  adds  the  function 
application,  with  that  same  variable  in  the  output  position,  to  the  subgoals  of  the 
clause  in  which  it  occurs  before  sending  the  input  to  the  system.  If  we  are  also  to 

'*The  version  of  the  system  which  was  generated  from  the  specification  given 
in  Chapter  15  is  slow  in  comparison  to  the  hand-written  version.  We  believe  this  is 
largely  due  to  the  simple-minded  pattern  matcher  being  used,  which  makes  actual 
substitutions  rather  than  simulating  them  with  binding  of  variables.  This  is  actually  a 
problem  with  the  implementation  of  natch  written  directly  in  LISP  rather  than  a 
problem  with  the  specification. 
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include  functions  that  have  not  yet  been  defined,  then  we  must  have  a way  of 
distinguishing  them  from  constructor  functions 17  , which  must  never  be  turned  into 
predicates.  This  is  not  difficult  and  can  be  done  in  any  of  a number  of  ways. 

Secondly,  we  can  extend  the  syntax  of  Horn  clauses  to  allow  mixed  conjunctions 
and  disjunctions  of  positive  literals  (still  no  negation  allowed)  on  the  right  hand  side 
of  the  V. 

Thirdly,  it  would  be  nice  to  allow  full  use  of  Predicate  Calculus  in  the 
specification  of  a function.  This  is  a much  more  difficult  problem.  Synthesis  of 
programs  from  general  descriptions  is  being  studied  by  several  researchers  ([C  771 
[CD  781  CCS  771  [D  751  CD  771  [DM  751  [MW  77al  [MW  77c]).  Hopefully,  their 
results  may  be  incorporated  in  this  system  in  the  future.  Brian  Beach,  a student  at  the 


University  of  California,  Santa  Cruz,  has  implemented  an  interactive  system  that  helps 
one  derive  Horn  clauses  from  more  general  statements  in  Predicate  Calculus  [B  791 

Lastly,  we  would  like  to  include  an  interactive  program  that  helps  the  user 
derive  the  specifications  for  a program  and  prove  the  correctness  of  the  specifications. 
The  system  could  check  the  completeness  of  the  specification  by  making  sure  that  at 
least  one  Horn  clause  is  applicable  to  every  element  of  the  domain  of  the  function  as 
specified  by  the  precondition.  This  is  difficult  in  general  but  for  inductively  defined 
domains  may  simply  be  a reminder  to  the  programmer  that  they  include  basis  and 

’'Constructor  functions  are  used  to  define  data  structures  inductively.  For 
example,  the  definition  of  type  S*t  given  on  page  21  uses  the  constructor  function 
Add-tlm. 
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constructed  elements.  To  prove  the  correctness  of  a specification  one  must:  DProve 
each  Horn  clause  as  a theorem  in  the  problem  domain;  2)  Prove  that  the  precondition 
guarantees  termination  of  the  program  (usually  a proof  by  induction  on  the  input); 
and  3)  Prove  that  successful  termination  of  the  program  always  results  in  an  answer 
satisfying  the  postcondition,  and  that  the  answer  produced  is  unique.  This  is  then  a 
proof  that  we  have  a correct  specification  of  a problem;  again,  we  can  never  prove  it 
is  the  problem  we  had  "in  mind*.  It  is  of  course  too  much  to  expect  that  the  system  be 
capable  of  doing  all  of  this  on  its  own,  but  a semi-automatic  verifier  or  proof  checker 
would  be  useful. 

There  are  also  several  extensions  to  the  capabilities  of  the  system  that  are 
desirable.  We  would  like  to  extend  the  use  of  generic  function  specifications  to  allow 
selection  of  individual  versions  of  the  function  by  type  of  the  arguments  as  well  as  by 
input  pattern.  Another  useful  feature  would  be  obtained  by  making  arrays  a 
primitive  data  type.  Array  access  is  not  achieved  efficiently  by  a logic  program;  since 
most  available  languages  offer  arrays  as  a primitive  type,  we  could  make  use  of  them 
in  specifications  realising  that  the  fast  index  algorithms  of  a target  language  would 
eventually  be  used  by  the  program. 

Functional  arguments  are  disallowed  in  any  first-order  theory,  however,  we  could 
circumvent  the  Jump  to  second  order  and  its  associated  problems  by  considering  the 
use  of  function  names  as  arguments.  These  names  could  then  indicate  where  we 
might  find  the  appropriate  definition  of  the  function  we  wish  to  use. 

Another  restriction  we  have  imposed  is  the  functionality  of  our  specifications. 
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This  gave  a great  savings  in  terms  of  the  limited  backtracking  needed  for  evaluation 
(over  clauses,  but  never  over  subgoals).  We  would  like  to  include  a way  of  indicating 
that  selective  subgoal  backtracking  is  desired.  This  would  give  us  the  ability  to  make 
statements  about  the  existence  of  an  answer  that  satisfies  several  subgoals 
simultaneously.  Each  subgoal  may  be  satisfied  by  a set  of  answers,  we  want  an 
element  of  the  Intersection  of  these  sets. 

There  are  several  ways  of  improving  the  efficiency  of  the  generated  programs. 
We  intend  to  incorporate  some  analysis  to  determine  the  best  ordering  of  alternatives 
and  of  subgoals  within  alternatives.  We  would  also  like  to  generate  programs  to 
optimize  the  source  language  programs  for  particular  target  languages.  In  languages  in 
which  recursion  is  implemented  inefficiently,  this  would  include  removal  of  recursion. 

The  most  dramatic  improvement  to  the  system  would  be  the  development  of  a 
program  that  could  automatically  generate  the  mapping  from  intermediate  to  target 
language  from  a formal  specification  of  the  syntax  and  semantics  of  the  target 
language.  This  is  similar  to  the  work  being  done  on  translator  writing  systems,  the 
difference  being  that  the  target  is  a high  level  programming  language  rather  than  a 
machine  language. 
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Appendix  A:  Sample  Specifications 


type  Nat 

body t Nat(x  trut ) *■  lnttger(x  true),  i(x  0 trut). 

(DEFUN  NAT  FEXPR  ( L ) 

(COND  ((TRUE-P RECON D (CONS  'NAT  L)) 
(BKTRKCOND  L 

'(((/X  T)  (TRY  (INTEGER  IX  T)  (i  IX  0 T )))))) 
(T  VNDEF))) 


generic  add 
parameter  list t (x  y x) 
choicest 

(110) 

function  name?  %/+ 
choicest 

(10  1) 

function  namet  add-2 
precondition t Integer(x)  a Integer(x). 
postcondition t Integer(y). 
body-name t sub-2 
choicest 


since  lf+  is  a function 
already  known  to  the  system,  no 
further  information  is  required 


Appendix  Ai  Semple  Speelflcetione  SS 


(Oil) 

function  nan* t add-1 
precondition  Integer(y)  a Integer(x). 
postcondition t Integer(x). 
body-nan et  sub-1 
choices t 

body-defs: 
sub-2 t 

addfx  y x)  «-  tf-(x  x y). 
sub-lt 

add(x  yx)*-  tf-(x  y x). 

(PUT PROP  'ADD  ’(((1 1 0) . IF+)  ((101).  ADD-2)  ((0  1 1) . ADD-1))  'GENERIC) 

(DEFUN  ADD-2  FEXPR  (L) 

( COND  ((TRUE-P RECON D ( CONS  'ADD-2  L)) 

(BKTRKCOND)L(try  (intecer  /x  t)  ,x  0 t )))))) 

(T  'UNDEF))) 

(DEFUN  ADD-1  FEXPR  (L) 

(COND  ((TRUE-P RECON D (CONS  ‘ADD-1  D) 

(BKTRKCONDL(tw  (intecer  /x  t)  ,x  0 T )))))) 

(T  'UNDEF))) 

END -OF -GENERIC -SPEC 


gtntrlc  inult 
parameter  list t (xyx) 
choicest 

(110) 

function  nanCt  1 f* 
choicest 
(0  I 1) 

function  nanet  inult-1 
precondition  Integer(y)  a Integer! x). 
postcondition  Integer(x). 
body-nanet  ldiv-1 
choicest 

(10  1) 

function  name?  inult-2 
precondition  lnteg*r(x)  a Integer(x). 


Integer  multiplication,  the  remit  will 
be  an  integer,  or  undef  if  there 
it  no  integer  meeting  the  semantics. 

Ordinary  multiplication,  as  above 
the  system  already  knows  it 
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postcondition ? Integer(y). 
body-name?  idiv-2 
choices? 

body-deft: 
idiv-l? 
lmult(0  x 0) 

lmult(undefO  x) «-  *(x  0) 

imultfx  yz)<-  lfll(z  y x),  imult(x  y z).  This  may  look  strange  but  it  will 

be  able  to  sort  out  which 
imult  to  use. 

tdlv-2: 
imult(x  0 0) 

ImuitfO  undef  x)  «-  *(x  0) 

imuitfx  y z)  «-  tfll(z  x y),  lmult(x  y z). 

(PUT  PROP  ‘ IMULT  ’(((1 1 0) . IF*)  (( 0 1 1 ) . I MULT-1)  ((1  0 1) . IMULT-2)) 
‘GENERIC) 

( DEFUN  I MULT-1  FEXPR  (L) 

(COND  ((T RUE-P RECON D ( CONS  ’IMULT-l  L)) 

(BKTRKCOND  L 

’(((IX  T)  (TRY  (INTEGER  IX  T)  (t  IX  0 T )))))) 

(T  ‘UNDEF))) 

(DEFUN  IMULT-2  FEXPR  (L) 

(COND  ((T  RUE-P  RECON  D (CONS  ‘IMULT-2  L)) 

(BKTRKCOND  L 

‘(((IX  T)  (TRY  (INTEGER  IX  T)  (i  IX  0 T )))))) 

(T  ’UNDEF))) 


ENDjOF -GEN  ERIC-SPEC 

***the  above  definitions  rely  heavily  on  the  arithmetic  already  defined  in  the  target 
language.  The  following  definitions  may  be  considered  more  typical.*** 
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function  ged  gcd(*  ? *)  me»n*  that  the  greatest 

Input-pattern?  (I  I 0)  common  dtvtsor  of  * and  y is  t. 

parameter  list?  (x  y t) 
precondition?  Nat(x  true)  a Nat(y  true), 
postcondition?  Nat(x  true), 
body?  gcd(0  0 undef) 
gcd(0  x x) 
gcd(x  0 x) 

gcd(x  y x)  *•  i(x  y),  add(y  to  x),  gcd(v)  y x) 
gcd(x  yx)-  i(y  x),  add(x  to  y),  gcd(x  to  x). 

(DEFUN  CCD  FEXPR  (L) 

(COND  ((TRUE-P RECON D (CONS  'CCD  L)) 

(BKTRKCOND  L 

'(((0  0 UNDEF)  (TRY)) 

((0  I X IX)  (TRY)) 

((/X  0 IX)  (TRY)) 

((IX  IY  IZ) 

(TRY  (i  IX  IY) 

(ADD-2  IY  IW  IX) 

(CCD  IW  IY  IZ))) 

((/X  IY  IZ) 

(TRY  (i  IY  IX) 

(ADD-2  IX  IW  IY) 

(GCD  IX  IW  IZ)))))) 

(T  'UNDEF))) 


generic  factor  factor(w  npr)  means  to»nP*r 

parameter  list?  (to  n p r)  and  p is  maximal 

choices? 

(0111) 

function  name?  factor-l 

precondition?  Nat(n  true)  a Nat(p  true)  a Nat(r  true), 
postcondition?  Natfu  true), 
body-name?  mult-out 
choices? 

(110  0) 

function  name?  factor-S4 
precondition?  Nat(w  true)  a Nat(n  true), 
postcondition?  Nat(p  true)  a Nat(r  true), 
body-name?  ss-f actor 
choices? 

body-defs : 
mult-out? 

factor(r  n 0 r)  *•  gcd(r  n 1) 


r 

i 

I 
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factorial  n pr ) - Imuitfn  r x),  tfsubKp  pi),  factorial  n pi  x). 

* 

ss-factoff 

factor(w  n 0 v) *■  <(w  n) 
factorial  nOai)*-  fcd(m  n I) 

factorial  n p r)  *■  t(ai  n),  Imultlv  n ui),factor(v  n pi  r),  addlpl  l p). 

• (PUT PROP  ’ FACTOR  Y 1(0  III).  FACTOR-1)  ((1 100).  FACTOR-34)) 
•GENERIC) 


! 


(DEFUN  FACTOR-1  FEXPR  (L) 

(COND  ((TRUE-P RECON D (CONS  ’ FACTOR-l  D) 
(BKTRKCOND  L 

'(HO  0 UNDEF)  (TRY)) 

UO  IX  IX)  (TRY)) 

1(1X0  IX)  (TRY)) 

((IX  IY  IZ) 

(TRY  (i  IX  IY) 

(ADD-2  IY  !W  IX) 

(CCD  IW  IY  IZ))) 

((/X  IY  IZ) 

(TRY  (i  IY  IX) 

(ADD-2  IX  IW  IY) 

(CCD  IX  IW  IZ)))))) 

(T  ’UNDEF))) 

( DEFUN  FACTOR-34  FEXPR  (L) 

(COND  ((TRUE-P RECON D (CONS  ’FACTOR-34  L)) 
(BKTRKCOND  L 

’( ((0  0 UNDEF)  (TRY)) 

(( 0 IX  IX)  (TRY)) 

((/X  0 IX)  (TRY)) 

((IX  IY  IZ) 

(TRY  (i  IX  IY) 

(ADD-2  IY  IW  IX) 

(CCD  IW  IY  IZ))) 

(UX  IY  IZ) 

(TRY  (i  IY  IX) 

( ADD-2  IX  IW  IY) 

(CCD  IX  IW  IZ)))))) 

(T  ’UNDEF))) 


f' 

[ 


'Jr  . 

•jTLS 


END-OF.OENERIC.SPEC 
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gtntrlc  E 

parameter  list t (xnyz) 
choicest 

(1110) 

function  name t E-4 

precondition t Nat(x  true)  a Nat(n  true)  a A fat(y  true), 
postcondition t Nat(t  true), 
body-namet  ebod-4 
choicest 

(1 1 01) 

function  namet  E-S 

precondition?  Nat(x  true)  a Nat(n  true)  a Nat(z  true), 
postconditlont  Nat(y  true), 
body-namet  ebod-S 
choicest 

(0  111) 

function  namet  E-l 

precondition t Nat(y  true)  a Nat(n  true)  a Nat(z  true), 
postconditlont  Nat(x  true), 
body-namet  ebod-1 
choicest 

body-defs: 

ebod-4? 

E(0  nyO)*-  Ay  0) 

E(x  nO  1)*-  Ax  0) 

E(l  nyl) 

E(x  n y z)  *-  factor(x  n p r),  lmult(p  y q),  add(n  1 nl),  E(r  nl  y s),factor(z  n q s). 
ebod-St 

E(x  n 0 1)  «-  Ax  0) 

E(x  nyz)*-  factor(x  n p r),  add(n  I nl).factor(z  n q s),  imult(p  y q),  E(r  nl  y s). 
ebod-1? 

E(0  nyO)  + Ay  0) 

E(l  nyl) 

E(x  nyz)  *■  factor(z  n q s),  imult(p  y q),  add(n  l nl),  E(r  nl  y s),factor(x  n p r). 
(PUT PROP  'E  ’(((1 110).  E-4)  ((l  101).  E-S)  ((0  111).  E-l))  ’ GENERIC ) 


A 
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I 


(DEFUN  E-4  FEXPR  (L) 

(COND  ((TRUE-P RECON D (CONS  ' E-4  L)) 
(BKTRKCOND  L 

'(((0  0 UNDEF)  (TRY)) 

((0  IX  !X)  (TRY)) 

((/X  0 IX)  (TRY)) 

((/X  IY  !Z) 

(TRY  (2  IX  IY) 

(ADD-2  IY  IW  IX) 

(CCD  IW  IY  IZ))) 

((/X  IY  IZ) 

(TRY  (2  IY  IX) 

(ADD-2  IX  IW  IY) 

(CCD  IX  IW  IZ)))))) 

(T  'UNDEF))) 


(DEFUN  E-3  FEXPR  (L) 

(COND  ((TRUE-P RECON D (CONS  'E-3  L)) 
(BKTRKCOND  L 

'(((0  0 UNDEF)  (TRY)) 

((0  IX  IX)  (TRY)) 

((/X  0 IX)  (TRY)) 

((/X  IY  IZ) 

(TRY  (2  IX  IY) 

(ADD-2  IY  IW  IX) 

(CCD  IW  IY  IZ))) 

((/X  IY  IZ) 

(TRY  (2  IY  IX) 

(ADD-2  IX  IW  IY) 

(CCD  IX  IW  IZ)))))) 

(T  ’UNDEF))) 

(DEFUN  E-l  FEXPR  (L) 

(COND  ((TRUE-P RECON D (CONS  'E-l  L)) 
(BKTRKCOND  L 

'(((0  0 UNDEF)  (TRY)) 

((0  IX  IX)  (TRY)) 

((IX  0 IX)  (TRY)) 

((IX  IY  IZ) 

(TRY  (2  IX  IY) 

(ADD-2  IY  IW  IX) 

(CCD  IW  IY  IZ))) 

((IX  IY  IZ) 

(TRY  (2  IY  IX) 

(ADD-2  IX  IW  IY) 

(CCD  IX  IW  IZ)))))) 
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(T  VNDEF))) 
ENDJOF -GENERIC -SPEC 


generic  exp  txp(xyz)  moan*  *>-* 

parameter  list t (x  y x) 

choicest 

(110) 

function  namrt  exp-3 
precondition t Nat(x)  a Nat(y). 
postcondition t Nat(z). 
body-name t expo 
choicest 

(10  1) 

function  namet  exp-2 
precondition t Nat(x)  a Nat(t). 
postcondUiont  Nat(y). 
body-namet  expo 
choicest 

(Oil) 

function  namet  exp-1 
preconditiont  Nat(z)  a Nat(y). 
postcondUiont  Nat(x). 
body-namet  expo 
choicest 

body-defs: 

expot 

ex p(x  y z)*-  E(x  2y  z). 

(PVT PROP  ’ EXP  ’(((l  I 0) . EXP-3)  ((I  0 1) . EXP-2)  ((0  1 1) . EXP-1)) 
’ GENERIC ) 

(DEFUN  EXP-3  FEXPR  (L) 

(COND  ((TRUE-P RECON D (CONS  'EXP-3  D) 

(BKTRKCOND  L 

'(((0  0 VNDEF ) (TRY)) 

((0  !X  IX)  (TRY)) 

((/X  0 IX)  (TRY)) 

(OX  1Y  IZ) 

(TRY  (i  IX  !Y) 

(ADD-2  IY  IW  IX) 

( CCD  IW  IY  IZ))) 

( (IX  IY  IZ) 
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(TRY  (2  /Y  IX) 

(ADD-2  !X  IW  IY) 

(CCD  IX  IW  IZ)))))) 

(T  'UNDEF))) 

(DEFUN  EXP-2  FEXPR  (L) 

(COND  ((TRUE-P RECON D (CONS  'EXP-2  L)) 
(BKTRKCOND  L 

'(((0  0 UNDEF ) (TRY)) 

((0  IX  IX)  (TRY)) 

((IX  0 IX)  (TRY)) 

((/X  IY  H ) 

(TRY  (2  IX  IY) 

(ADD-2  IY  IW  IX) 

(CCD  IW  IY  IZ))) 

((IX  IY  IZ) 

(TRY  (2  IY  IX) 

(ADD-2  IX  IW  IY) 

(CCD  IX  IW  IZ)))))) 

(T  VNDEF))) 

(DEFUN  EXP-I  FEXPR  (L) 

(COND  ((TRUE-P RECON D (CONS  'EXP-1  L)) 
(BKTRKCOND  L 

’( ((0  0 UNDEF ) (TRY)) 

((0  IX  IX)  (TRY)) 

(OX  0 IX)  (TRY)) 

((IX  IY  IZ) 

(TRY  (2  IX  IY) 

(ADD-2  IY  IW  IX) 

(CCD  IW  IY  IZ))) 

((/X  IY  IZ) 

(TRY  (2  IY  IX) 

(ADD-2  IX  IW  IY) 

(CCD  IX  IW  IZ)))))) 

(T  VNDEF))) 


ENDjOF -GENERIC-SPEC 


typ t It-Mt 
body! 

Is-s*t(’mt-s*tjru4) 
is-i*t(  add-4ltn(x, t),  tr\u) 


ls-nt(s,  tnu),  s*t-mm(x,  t.falu). 


[ : 
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(DEFUN  IS-SET  FEXPR  (L) 

(COND  ((TRUE-P  RECON  D (CONS  ‘IS-SET  L)) 
(BKTRKCOND  L 

‘(((‘MT-SET  T)  (TRY)) 
(((ADD-ELEM  IX  IS)  T) 

(TRY  (IS-SET  IS  T) 

(SET-MEM  IX  IS  FALSE)))))) 

(T  VNDEF))) 


function  set-mem 
Input  pattern t (110) 
parameter  list f (x  y z) 
precondition f is-set(y,  true), 
postcondition f booleanfx,  true), 
body f 

set-mem(x,  ‘mt-set,  false) 

set-mem(x,  add-elem(x,  s),  true) 

set-mem(x,  add-elem(y,  s),  true) «-  sct-mem(x,  s,  true) 

set-mem( x,  add-elem(y,  s),  false)  *■  sams(x,y,  x),  same(x,  false,  true), 

stt-mem(x,  s,  false). 

(DEFUN  SET-MEM  FEXPR  (L) 

(COND  ((TRUE-P RECON D (CONS  'SET-MEM  L)) 
(BKTRKCOND  L 

’(((/X  ‘MT-SET  FALSE)  (TRY)) 

((/X  (ADD-ELEM  IX  IS)  T)  (TRY)) 

((/X  (ADD-ELEM  IY  IS)  T) 

(TRY  ( SET-MEM  IX  IS  T))) 

((/X  (ADD-ELEM  IY  IS)  FALSE) 

(TRY  (SAME  IX  IY  !Z) 

(SAME  /Z  FALSE  T) 

(SET-MEM  IX  IS  FALSE)))))) 

(T  VNDEF))) 


function  same 
input  pattern 1 (I  I 0) 
parameter  list f 
body T 

same(x  x true) 
same(x  y false). 

(DEFUN  SAME  FEXPR  (L) 

(COND  ((TRUE-P RECON D (CONS  ‘SAME  L)) 
(BKTRKCOND  L 

'(((IX  IX  T)  (TRY))  ((/X  IY  FALSE)  (TRY))))) 
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r 


r 


(T  VNDEF))) 


function  union 

input  pattern ? (1 1 0) 

parameter  list?  (x  y x) 

precondition ? ls-set(x,  true)  a Is-set(yjtnu). 

postcondition?  is-set(z,  true). 

body? 

unlonCmt-set,  y,  y) 
unlonfx,  'mt-set,  x) 

union(add-elem(xj),  y,  add-elem(xx ))  *•  set-mem(x,  y, false),  unionfs,  y,  x) 
union(add-elem(xj),y,  x) «-  set-mem(x,y,  true),  unlon(s,  y,  x). 

(DEFUN  UNION  FEXPR  (L) 

(COND  ((TRUE-P RECON D (CONS  'UNION  L)) 

(BKTRKCOND  L 

'((('MT-SET  IY  IY)  (TRY)) 

(OX  'MT-SET  IX)  (TRY)) 

(((ADD-ELEM  IX  IS)  IY  (ADD-ELEM  IX  IZ)) 
(TRY  (SET-MEM  IX  IY  FALSE) 

(UNION  IS  IY  IZ))) 

(((ADD-ELEM  IX  IS)  IY  IZ) 

(TRY  (SET-MEM  IX  IY  T) 

(UNION  IS  IY  IZ)))))) 

(T  'UNDEF))) 


type  Intlist 
body? 

Intllst(Ojrue) 

lntllst(cons(x,  l),  true)  *■  lnteger(x,  true),  lntlist(l,  true). 

(DEFUN  INTLIST  FEXPR  (L) 

(COND  ((TRUE-P RECON D (CONS  'INTLIST  L)) 
(BKTRKCOND  L 

'(((NIL  T)  (TRY)) 

(((CONS  IX  IL)  T) 

(TRY  (INTEGER  IX  T)  (INTLIST  IL  T)))))) 
(T  VNDEF))) 

function  Insertsort 

Input  pattern?  (I  0) 

parameter  list?  (xy) 

precond?  IntUstfx,  true). 

postcondf  lntllst(y,  true)  a Perm(x,y,  true). 
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body? 

Insert  sort(()J()) 

lnsertsort(cons(xJ),y)  *-  lnsertsort(l,  w),  lnsert(x,  w,y). 


i 


( DEFUN  INSERTSORT  FEXPR  (L) 

(COND  ((TRUE-PRECOND  (CONS  ’INSERTSORT 
(BKTRKCOND  L 

’(((NIL  NIL)  (TRY)) 

(((CONS  IX  !L)  IV) 

(TRY  (INSERTSORT  IL  IW) 
(INSERT  IX  IW  IY)))))) 

(T  ’UNDEF))) 


L)) 


/Unction  Insert 

input  pattern?  (I  I 0) 

parameter  list?  (x  y z) 

precond?  Integer(x,  true)  a Intlistfy,  true). 

postcond?  Intllstfx,  true). 

body? 

Insert(x,  (),  consfx,  ())) 

lnsert(x,  cons(yj),  cons(x,  cons(yj)))  *■  tpsfx.y,  true) 
Insertfx,  cons(yi),  cons(yjt)) «-  tp>(x,y,  true),  lnsert(x,  l,  t). 


. i 


1 

\ 


t 

l 


(DEFUN  INSERT  FEXPR  (L) 

(COND  ((TRUE-PRECOND  (CONS  ’INSERT  L)) 
(BKTRKCOND  L 

WX  NIL  (CONS  IX  NIL))  (TRY)) 

((IX  (CONS  IY  IL)  (CONS  IX  (CONS  IY  IL))) 
(TRY  (IPS  IX  IY  T))) 

((IX  (CONS  IY  IL)  (CONS  IY  12)) 

(TRY  (tP>  IX  IY  T)  (INSERT  IX  IL  IZ)))))) 
(T  ’UNDEF))) 

function  Selectlonsort 

Input  pattern?  (10) 

parameter  list?  (x  y) 

precond?  Intllst(x,  true). 

postcond?  Intllst(y,  true)  a Perm(x,  y,  true). 

body? 

Selectloruort((),  ()) 

Selectlonsort(cons(xMl),  cons(yM))  *■  Partltlon-by-mln(cons(xjul),J,  u2), 

Selectionsort(u2.  u). 

(DEFUN  SELECT  ION  SORT  FEXPR  (L) 

(COND  ((TRUE-PRECOND  (CONS  ’SELECT  ION  SORT  L)) 


l 


SI 
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(BKTRKCOND  L 

•(((NIL  NIL ) (TRY)) 

(((CONS  IX  IU1)  (CONS  IY  !U)) 

(TRY  (PART  IT  ION -BY -M  IN  (CONS  IX  IV  l) 
!Y 

IU2) 

(SELECTIONSORT  IU2  IV)))))) 

(T  VNDEF))) 


function  Partitlon-by-min 

input  pattern t (10  0) 

parameter  Hut  (ul  x u2 ) 

precondt  IntliUful,  true)  a Non-empty(ul,  true). 

poucondt  lnteger(x,  true)  a Intlitt(u2,  true). 

body t 

Partltlon-by-mln(cons(xJ()),  x,  ()) 

Partition-&y-mln(com(x,  comfy, u)).  *,  comfytil))  + 

Zpi(x,  y,  true),  PartUlon-by-mln(com(xM),  x,  ul) 
Partitlon-by-min(cons(x,  cons(yM)).  x,  com(x,ul))  «- 
tp>(x,  y,  true),  Partition-by-min(com(yM),  *,  ul). 

(DEFVN  PARTITION -BY -MIN  FEXPR  (L) 

(COND  ((TRVE-P RECON D (CONS  ’ PARTITION -BY -MIN  L)) 
(BKTRKCOND  L 

’((((CONS  IX  NIL)  IX  NIL)  (TRY)) 

(((CONS  IX  (CONS  IY  IV))  IZ  (CONS  IY  fV !)) 
(TRY  (iPi  IX  IY  T) 

(PARTITION -BY -MIN  (CONS  IX  IV) 

IZ 

IUI))) 

(((CONS  IX  (CONS  IY  IV))  IZ  (CONS  IX  /VI)) 
(TRY  (tP>  IX  IY  T) 

(PARTITJON-BY-MIN  (CONS  IY  IV) 

IZ 

IVl)))))) 

(T  VNDEF))) 


function  Non-empty 
Input  patternf  (1  0) 
parameter  list t (I  x) 
precondt  Ust(l,  true), 
poucondt  Booleanfx,  true). 


Bfanu* 


AppfBdU  A)  Itapli  IpNtflMttMU  107 


body? 

Non-tmpty(( ) foist) 

Non-tmpty(cons(y,  u),  trut). 

(DEFUN  NON-EMPTY  FEXPR  (L) 

(COND  ((TRUE-P RECON D (CONS  'NON-EMPTY  D) 
(BKTRKCOND  L 

'(((NIL  FALSE)  (TRY)) 

(((CONS  IY  IU ) T)  (TRY))))) 

(T  'UNDEF))) 


function  Ptrm 

input  patttrn?  (10) 

paramtttr  list ? (x  y t) 

prtcond?  List(x,  trut)  a List(y,  trut). 

postcond?  Boolean!  x,  trut). 

body ? 

Ptrm(  (),(),  trut) 

Ptrm(cons(xMl),  cons(x,u2 ),  trut ) «-  Ptrm(u],  u2.  trut) 
Ptrm(cons(xMl).  cons(y,u2),  trut)  *■  Dtlttt(x,  u2,  u3), 

Dtltttfy,  u2,  u4),  Ptrm(u3,  u4,  trut). 

(DEFUN  PERM  FEXPR  (L) 

(COND  ((TRUE-P RECON D (CONS  'PERM  L)) 
(BKTRKCOND  L 

'(((NIL  NIL  T)  (TRY)) 

(((CONS  IX  IUI)  (CONS  IX  IU2)  T) 

(TRY  (PERM  IUI  IU2  T))) 

(((CONS  IX  IUI)  (CONS  IY  IU2)  T) 

(TRY  ( DELETE  IX  IU2  IU3) 

(DELETE  IY  IU2  IU4) 

(PERM  IU3  IU4  T )))))) 

(T  'UNDEF))) 


function  Dtlttt 
Input  pattern?  (110) 
paramtttr  list?  (x  ul  u2) 
prtcond?  Llst(ul,  trut). 

postcond?  Llst(u2,  trut)  a Ptrm(cons(x,  u2),  ul,  trut). 
body ? 

Delttt(x,  (),  undtf) 

Dtlttt(x,  eons(xj),  l) 

Dtltltfx,  cons(yj),  undtf)  «•  Dtlttt(x,  l,  undtf) 


Pv  % 


y ...  • 
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Delete(x,  cons(yMl),  cons(y,u2))  *■  Deleteix,  ul,  u2). 

(DEFUN  DELETE  FEXPR  (L) 

(COND  ((TRUE-P RECON D (CONS  'DELETE  L)) 
(BKTRKCOND  L 

‘(((/X  NIL  UNDEF ) (TRY)) 

((IX  (CONS  IX  IL)  IL)  (TRY)) 

((/X  (CONS  IY  IL)  UNDEF) 

(TRY  (DELETE  IX  IL  UNDEF))) 
((IX  (CONS  IY  IUI)  (CONS  IY  IU2)) 
(TRY  (DELETE  IX  IUI  IU2)))))) 

(T  'UNDEF))) 


function  Fact 
input  pattern}  (10) 
parameter  list?  (x  y) 

precondf  lnteger(x,  true)  a Createrequalfx,  0,  true), 
postcondt  Integerfy,  true)  a Lessthan(0,  y,  true). 

Mf  Fact(0  I) 

Factfx,  y)  *■  Subl(x,  xl),  Fact(xl,  yl),  Timtt(x,  yl,  y). 

The  above  specification  for  the  factorial  function  results  in  the  following 
Pascal  program. 

PROGRAM  G 0002, FACT; 

TYPE 

ALLTYPS  - (INTECERTYP.  REALTYP,  BOOLEANTYP, 
CHARTYP,  SYMBOLTYPh 

TERMTYPS  - (VARIABLE,  CONSTANTTYP,  FUNAPP); 
TERM  - tTI; 

TERMLIST  - TTLI; 


CONSTANT  - TCI 
SYMBOL  - TSYMI 


Tl  - RECORD 

CASE  TTYPTERMTYPS  OF 

VARIABLE:  (VR:  INTEGER); 
CONSTANTTYP:  (CNST:  CONSTANT); 
FUNAPP:  (FNAME:  SYMBOL; 


I 
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ARCS:  TERMLIST) 

END; 

I 

TLl  - RECORD 

NOTEMPTY:  BOOLEAN; 

FIRST:  TERM; 

REST:  TERMLIST 
END; 

Cl  - RECORD 

CASE  CTYP:ALLTYPS  OF 

i INTECERTYP:  (IVAL:  INTECER); 

REALTYP:  (RVAL:  REAL); 

BOOLEANTYP:  (BVAL:  BOOLEAN); 

CHARTYP:  (CVAL:  CHAR); 

I SYMBOLTYP:(SVAL:  SYMBOL) 

END; 

SYM I - RECORD 

NOTEMPTY:  BOOLEAN; 

[ FIRSTCH:  CHAR; 

TAIL:  SYMBOL; 

l END; 


VARPAIRS  - TVP; 


t 


VP  - RECORD 

NOTEMPTY.  BOOLEAN; 

OLD:  INTECER; 

NEW:  INTECER; 

REST:  VARPAIRS 
END; 

FUNCTION  GREATEREQUAL(X,  Y:  TERM;  VAR  Z:  TERM):  BOOLEAN; 
EXTERN, 

FUNCTION  SUBl(X:TERM;  VAR  Y:  TERM):  BOOLEAN; 

EXTERN; 

FUNCTION  TIMES(X,  Y:  TERM;  VAR  Z:  TERM):  BOOLEAN; 

EXTERN; 

FUNCTION  OCCUR(X.  Y:  TERM):  BOOLEAN; 

EXTERN; 

FUNCTION  GENVAR:  INTECER; 

EXTERN; 

PROCEDURE  REPLACE(X,  T:  TERM;  VAR  TML:  TERMLIST); 

EXTERN; 

PROCEDURE  SUBST(X,  T:  TERM;  VAR  Tl,  T2:  TERMLISTX 


I i 
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EXTERN; 

FUNCTION  EQ$YM(X,  Y:  SYMBOL):  BOOLEAN; 

EXTERN; 

FUNCTION  EQCONST(X,  Y:  CONSTANT):  BOOLEAN; 

EXTERN; 

FUNCTION  COPYSYM(OLDSYM:  SYMBOL):  SYMBOL; 

EXTERN; 

FUNCTION  COPYTERM(OLDTM:  TERM):  TERM; 

EXTERN; 

FUNCTION  COP YTER M LIST(TM L:  TERMLIST>.  TERMLIST; 

EXTERN; 

FUNCTION  COPYCON$T{OLDCONST:  CONSTANT):  CONSTANT; 
EXTERN- 

FUNCTION  UNIFY(VAR  X,  Y,  ALLX,  ALLY:  TERMLIST; 

FAILED:  BOOLEAN):  BOOLEAN; 

EXTERN; 

PROCEDURE  LOOKUP(TM:  TERM;  TBL:  VARPAIRS; 

FOUND:  BOOLEAN); 

EXTERN; 

PROCEDURE  STANDAPART(TML:  TERMLIST; 

VAR  DONETBL:  VARPAIRS); 

EXTERN; 

FUNCTION  FACT(X  : TERM  ; VAR  Y : TERM):  BOOLEAN; 

VAR 

G0014,  C001 1.  C00I0,  00009,  G0008,  C0007,  ACTUALS,  COPYACTUALS 
, MATCHLIST:  TERMLIST; 

COO  1 5,  G0012,  Zl.  Wl.  W.  Z,  C0005,  G0003:  TERM; 

C0016,  C00J3,  C0006,  G0004:  CONSTANT; 

DONETBL:  VARPAIRS; 

FLAG,  FAILED:  BOOLEAN; 

BEGIN 

IF 

(GREATEREQUAL  (X,  G0003,  G0005)) 

THEN  BEGIN 

NEW(ACTUALS); 

ACTUALST.NOTEMPTY  FALSE; 

NEW(G0008); 

G0008T.NOTEMPTY  :-  TRUE; 

C0008t.FIRST  :-  Y; 

G0008T.REST  :-  ACTUALS; 

ACTUALS  :-  G0008; 

NEW(G0007); 

C0007t.NOTEMPTY  :-  TRUE; 

G0007T.FIRST  :-  X; 

C0007T.REST :-  ACTUALS; 
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ACTUALS  C0007; 

COPYACTUALS  COPYTERMLIST(ACTUALS); 
NEW(DONETBL); 

DONETBLt.NOTEMPTY  FALSE; 
STANDAPART(COPYACTUALS.  DONETBLh 
NEW(MATCHLIST); 

MATCHLISTT.NOTEMPTY  > FALSE; 

NEW(GOOU); 

COOMT.NOTEMPTY  TRUE; 

NEW(G0015); 

C0015T.TTYP  CONSTANTTYP; 

NEW(C0016>; 

G0016t.CTYP  :•  INTEGERTYP; 

COOI6t.IVAL  :■  0; 

G00I5T.CNST  G00I6; 

G00I4T.FIRST  > G0015; 

GOOMt.REST  MATCHLIST; 

MATCHLIST:-  C0014; 

NEW(GOOIl); 

G001  lt.NOTEMPTY  TRUE; 

NEW(C00J2); 

G0012T.TTYP  CONSTANTTYP; 

NEW(G0013); 

C0013T.CTYP  INTEGERTYP; 

G0013MVAL  I; 

G00I2T.CNST  GOO  1 3; 

C00J  IT.FIRST G0012; 

COOIIT.REST  MATCHLIST; 

MATCHLIST  > G00II; 

IF  UNIFY(COPYACTUALS  , MATCHLIST, 

COPYACTUALS,  MATCHLIST,  FAILED) 
THEN  BEGIN 

FAILED  NOT  TRUE 
END 

ELSE  FAILED  TRUE; 

COPYACTUALS  COPYTERMLIST(ACTUALS); 
NEW(DONETBL); 

DONETBLT.NOTEMPTY FALSE; 
STANDAPART(COPYACTUALS,  DONETBL>, 
NEW(MATCHLIST); 

MATCHLISTt.NOTEMPTY  FALSE; 

NEW(GOOIO); 

GOOIOT.NOTEMPTY  TRUE; 

NEW(W); 

WT.TTYP  VARIABLE; 

WT.VR  GENVAR; 


.»  < K'  ' ‘ 


fi 

I 
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COOlOt.FIRST  W; 

GOOlOt.REST  MATCHLIST; 

MATCHLIST  :•  G0010; 

NEW(G0009); 

C0009T.NOTEMPTY  TRUE; 

NEW(Zh 

Zt.TTYP  VARIABLE; 

Zt.VR  CENVAR; 

C0009t .FIRST  Z; 

COOOflt.REST  MATCHLIST; 

MATCHLIST G0009; 

IF  UNIFY(COPYACTUALS  , MATCHLIST, 

COPYACTUALS,  MATCHLIST,  FAILED) 

THEN  BEGIN 
NEW(WI>, 

WIT.TTYP  VARIABLE; 

WIt.VR  GEN  VAR; 

NEW(Wl); 

Wlt.TTYP  VARIABLE; 

WIt.VR  CENVAR; 

NEW(Zl); 

ZIT.TTYP  VARIABLE; 

Zlt.VR  CENVAR; 

NEW(ZI); 

Zlt.TTYP  :•  VARIABLE; 

Zlt.VR  CENVAR; 

FAILED  NOT(SUBI  (W  Wl)  AND  FACT(W1  Zl) 

AND  TIMES  (WZ I Z)) 

END 

ELSE  FAILED  TRUE; 

FLAG  NOT  FAILED; 

FACT  FLAC; 

IF  FLAC 
THEN  BEGIN 

X :-COPYACTUALSt.FIRST; 

COPYACTUALS COPYACTUALSt.REST; 

Y :-COPYACTUALSt.FIRST; 

COPYACTUALS COPYACTUALSt.REST; 

END 

END 

ELSE  FACT:- FALSE  . 

END; 

BEGIN  END. 
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Appendix  B:  Specification  of  a Program  Synthesis  System 


Note  that  env  is  used  to  denote  a global  environment  containing  information 
necessary  to  several  of  the  following  functions.  The  structure  of  env  is 
a list  of  three  elements:  1)  a list  of  all  generic  function  names  along  with  their 
selection  lists;  2)  a list  of  the  names  of  all  functions  defined  so  far,  and 
3)  a list  of  all  types  defined  so  far.  The  environment,  env,  is  initialized 
to  a list  consisting  of  three  empty  lists. 


function  syn 

Input  pattern ? (l  1 1 0 0) 
parameter  list? 

syn(speci,  target,  envinit,  program,  newenv)  «■ 
fir  stsym(  sped,  nxtsym,  spec), 
lnt( nxtsym,  spec,  envinit,  int-prog,  newenv), 
trans(lnt-prog,  newenv,  target,  program). 


function  Int 

input  pattern?  (1 1 1 0 0) 
parameter  list? 

lnt(\ function,  spec,  oldenv,  Int-prog,  newenv)  *■ 
fun- spec( spec,  oldenv,  int-prog,  newenv) 
tnt(’type,  spec,  oldenv,  int-prog,  newenv)  ♦* 

type-specfspec,  oldenv,  int-prog,  newenv) 


B I 
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lnt(' generic,  sptc,  oldtnv,  ini-prog,  ntiutnv)  «- 
gtn-sptc(sptc,  oldtnv,  int-prog,  ntiutnv). 


function  fUn-sptc 
Input  patUrnt  (l  l 0 0) 
paramtttr  list? 

fun-sptc(sptc,  oldtnv,  list(' function,  namt,  inpat,  param,  prtcond,  postcond,  body), 
ntiutnv)  *- 

flrstsym(sptc,  namt,  mort2), 

wrlte("lnput~patttrn?"),firsttxp(mort2,  inpat,  mortJ), 
writ  t("  parameter  list?"),  firsttxp(mort3,  params,  morti), 
wrltt("  precondition?"),  is-dis)unct(mort4,  prtcond,  mart!), 
wrlte(m  postcondition?"),  is-disjunct(morti , postcond,  mort6), 
addfun( oldtnv,  namt,  ntiutnv), 

wrlttCbody?"),  ls-body(mort6 , body,  morn,  undtf,  ntwtnv,  Inpat). 


function  Is-disjunct 
Input  pattern 7 (10  0) 
paramtttr  list? 
ls-dlsjunct(sptc,  disj,  mort)  «- 

is-conjunct(sptc,  con),  morti,  nxtsym), 
finis ft-dis)(mortl,  nxtsym,  con),  disj,  mort). 


function  flnlsh-dls) 

Input  pottcrn?(l  110  0) 
paramtttr  list ? 

flnlsh-dls)(sptc,  V,  con),  llstfv,  con),  disj),  mort) 
ls-dls)unct(sptc,  dls),  mort) 
flnlsh~dls)(sptc, con),  con),  sptc). 


function  is-con)unct 
Input  pattern?  (10  0 0) 
paramtttr  list? 

is-con)unct(sptc,  con),  mort,  nxtsym)  *■ 
fir stsymf sptc.  litsym,  morti), 

Is-llttraUllttym,  morti,  lit,  mort2,  mldsym), 
finisk-con)(mort2,  midsym,  lit,  con),  mort,  nxtsym). 
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input  pattern?  (1  1 1 0 0 0) 
paramtttr  list ? 

finith-conj(sptc,  ’a,  lit,  list(’ a,  lit,  conj),  more,  nxtsym)  *- 
is-conjunct(spec,  conj,  more,  nxtsym) 
flnlsh-conJ(spec,  lit,  lit,  spec,  I.). 


function  is-literal 
Input  pattern ? (l  I 0 0 0) 
parameter  list? 

is-llteralCTRUE,  spec,  T,  more,  nxtsym)  *■  firstsym(spec,  nxtsym,  more) 
is-literal(T,  spec,  T,  more,  nxtsym)  ► firstsym(spec,  nxtsym,  more) 
Is-literalCH,  spec,  disj,  more,  nxtsym)  *■  is-disjunct(spec,  disj,  morel), 
firstsym(morel,  ’I),  more2),  first sym(more2,  nxtsym,  more) 
ls-literal(name,  spec,  atmf,  more,  nxtsym)  *■  firstsym(spec, '!(,  morel), 
ls-funapp(name,  morel,  atmf,  more,  nxtsym). 


; i 


function  is-funapp 
Input  pattern?  (110  0 0) 
parameter  list? 

is-funapp(name,  spec,  cons(name,  arglist),  more,  nxtsym)  *■ 
ls-arglist(spec,  arglist,  more,  nxtsym). 


function  is-arglist 
input  pattern?  (10  0 0) 
parameter  list? 

is-argllst(spec,  arglist,  more,  nxtsym)  «- 
firstsym(spec,  argsym,  mort2), 
read-args(argsym,  more2,  arglist,  more, nxtsym). 


function  read-args 
input  pattern?  (1  10  0 0) 
parameter  list? 

read-args(’l),  spec,  (),  more,  nxtsym ) *■  firstsym(spec,  nxtsym,  more) 
read-args(argsym,  spec,  cons(argfirgllst),  more,  nxtsym)  «- 
ls-arg(argsym,  spec,  arg,  morel,  midsym), 
read-args(mldsym,  morel,  arglist,  more,  nxtsym). 


function  is-arg 
input  pattern?  (110  0 0) 


i 


- 


i 


4 


u 
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parameter  list t 

ls-arg(argsym,  sptc,  const,  more,  nxtsym) «-  is-constnt(argsym,  spec,  const,  morel), 
first sym( morel,  nxtsym,  more) 

ls-arg(namt,  spec,  arg,  more,  lastsym)  ► firstsym(spec,  nxtsym,  morel), 
flnlsh-arg(nxtsym,  name,  morel,  arg,  more,  lastsym). 


function  finlsh-arg 
Input  pattern t (11  10  0 0) 
parameter  list t 

finis h-arg(’l(,  name,  sptc.fnapp,  more,  nxtsym)  «- 
is-funapp( name,  spec,  fnapp,  more,  nxtsym) 
flnish-arg(nxtsym,  name,  spec,  name,  spec,  nxtsym). 


function  Is-constnt 
Input  pattern T (110  0) 
parameter  list t 

ls~constnt(T,  spec,  llst('quotesxp),  more)  «- 
fir stexp( spec,  exp,  more) 

ls-constnt(number,  spec,  number,  more)  *•  Integer(number) 
ls-constnt(number,  spec,  number,  more)  *■  realjnumber) 
ls-constnt('undef,  spec,  undef,  more) 
ls-constnt('false,  spec,  false,  more) 

Is-constntCtrue,  spec,  t,  more) 
ls-constnt('t,  spec,  t,  more) 

Is-constntCH,  spec,  (),  more) «-  firstsym(spec,’l)jnore). 


function  Is-body 

Input  pattern t (I  0 0 1 1 1) 

parameter  list t 

Is-bodyfspectonsCbktrkcondAlternatlvesjjnoregenflagjnvinpat)  «- 
fir  stsym(  spec,  sym,  morel), 

ls-hornclauses(  sym,  morel  Alternatives  jnoregenflag/noinpat). 


function  Is-hornclauses 
Input  pattern ? (110  0 111) 
parameter  list t 

Is-hornclausesCl.,  specl),moregenflagjenvinpat) 
ls-hornclauses(name,  spec,  cons( match-try-pair Alternatives), 

moregenflag/nvjnpat ) *- 

firstsym(spec,  ’!(,  sped), 

is-hclause(namejptc2, match-try-pair, morel, genflagsnvlnpat, nxtsym), 
ls-hornclauses(nxtsym, morel  Alternativesjmorefenflag/mvlnpat). 
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function  is-Mause 

input  pattern P (1 1 0 0 1 1 / 0) 

parameter  list} 

ls-Aclause(nameepeclist(arglistjrylist),more.gsnflagenvlnpatlostsym)  «■ 
ls-funapp(namejpecjcons(namifirgllst)fliorel,nxtsym), 
finlsA-hclausetnxtsym,  name,  arglist,  inpat,  gtnflag, «»,  morel, 
tryllst,  lastsym). 


function  flnlsA-Aclause 

input  pattern t (1 1 1 1 1 1 1 0 0 0) 

parameter  list} 

flnlsA-Aclauset V,  nam«,  arglist,  Inpat,  genflag,  env,  spec,  tryllst, 

more,  ruetsym ) «- 

mk-known(lnpat,  arglist,  (),  knownvars), 
ls-subgoalist(spec,  tryllst,  more,  env,  knownvars,  genflag,  nxtsym) 
flnlsA-Aclausetnxtsym,  name,  arglist,  inpat,  genflag,  env,  spec, 
cons(' try,  0).  spec,  nxtsym). 


function  is-subgoallst 
input  pattern?  (1  0 0 1 1 I 0) 
parameter  list} 

is-subgoalist(spec/cons('tryfions(cons(fnamsArglist)jbgllst))jnoroAnv, 
knownvars  false  lastsym)  *• 

firstsym(spec,namejpec2).firstsym(spec2. '!(,  spec)), 
ls~funapp{  name  spec)  const  name  Arglist)  morel; nxtsym), 
ck-generict  name  env  Arglist,  knownvarsfname), 
mk-ollknown(arglistjinownvars,newknownvars), 
rd-subgoalstnxtsym, morel  cbglist, more  env, newknownvars  false  lastsym) 
Is-subgoalistt iptcconsi  try  const  const  namsArglist)cbgllst))Aiore/nv, 
knownvars  true  lastsym)  *- 

firstsym( spec, name jpec2),firstsym(spec2,  ’It,  spec)), 

Is-funa  pptname,  spec)  const  name  Arglist)  more  I, nxtsym), 
r<i-subgoals(nxtsymmoreljbgUstmorecnvJtnownoarsiruelastsym). 


function  rd-subgoals 
input  pattern}  (1 1 0 0 1 1 1 0) 
parameter  list} 

rd-subgoaIs(’ljpeccons(  const  nameArgllst)cbglist), 

more  env  hnownvars  true  lasttvn)  «- 
flrstsym(spec,namemorel),  flrstsymt  morel,  'It,  morell), 
is-funapp(namemorel2cons(namsArgUst)mors2, nxtsym), 
rd-subgoals(nxtsymtnore2ebglistcnoreenviinownvorsjruejostsjm) 
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Td-su.bgoalsCUp*ctons(cons(fname,argliu)jbglist), 

more, tnv  Jtnownvars false /astsym)  *■ 
fir  st  sym(  spec, name, more  I ),  first  symfmort  l, '/(,  mort2l), 
ls-funapp(name,more21{onj(nameArgUst)jnore2,nxtsym), 
ck-gtntric(namtjinv  fir  glist  knownvars  fnamt), 
mk~allknown(arglistknownvars,newknownvars), 
rd-subgoals(nxtsymtnort2jbglistsnore4nv,newknownvars  false  Jastsym) 
rd-subgoals(nxtsym,  spec,  (),  spa,  tnv,  knownvars,  gtnflag,  nxtsym) . 


function  ck-gtneric 
input  pattern ? (1 1 II  0) 
parameter  list? 

ck-gtneric(name,  tnv,  argllst,  knownvars,  name) «-  gtntricfname,  tnv,  undtf) 
ck-generlc(namt,  tnv,  argllst,  knownvars,  fnamt)  «- 
gtntrlcfnamt,  tnv,  selections), 
mk_pct(arrlist,  knownvars,  Inpat), 
choosi~fun( inpat,  selections,  fnamt). 


function  generic 
input  pattern?  (1 1 0) 
paramtttr  list? 

generic(namtjist(  generics  functions,  types),  selections)  *■ 
findin(  name generic: selections). 


function  findin 

Input  pattern?  (110) 

parameter  list? 

findinfnamt,  (),  'undtf) 

findinfnamt,  cons(cons(namex)y),  x) 

findinfnamt,  cons(cons(other*)j),  t)  *■  findinfnamtyt). 


function  addfun 
input  pattern?  (I  I 0) 
parameter  list? 


addfunC Ust( generics  functions  types)  .name, 

listf  gentries,  consfnane  functions)  types)). 


4 


Appendix  Bi  Specif  lotion  of  a Prod  ran  SyntboeU  djnten  Ml 

/ unction  not-ln 
input  pattern?  (1 1) 
paramtttr  list ? 
not~in(xl)) 

not-in(xjl)  member(x)  false). 


function  member 

input  pattern ? (110) 

parameter  list! 

member ( xfonsf  xJ)jtrue) 

member(xjcons(yl)Ans) «-  member(xlfins) 

member(xf)false). 


function  mk-allknoun 
Input  pattern ? (110) 
parameter  list ? 

mk-allknoun(OMounvarsJtnounvars) 

mk-allknown(cons(xj),  knounvars,  neuknounvars)  «■  varsjn(xjvl), 

mk-allknown(l,  knounvars,  nkv),  appendS(vl,  nkv,  neuknounvars). 


function  mk-knoun 
input  pattern?  (1110) 
parameter  list? 

mk-known((),  (),  knouinvars,  knouinvars) 

mk-knoun(cons(l/),  cons(xjt),  knouinvars,  neuiknounvars) «-  varsJn(xjri), 
mk-knouindMJtnouinvars,  nkv),  appendtfvl,  nkv,  neuknounvars) 
mk-knoun(cons(OJ),  cons(xjs),  knouinvars,  neuiknounvars)  *■ 
mk-knoun(l,  k,  knounvars,  neuknounvars). 


function  varsJn 
input  pattern?  (10) 
parameter  list ? 

varsJn(expK))  - itsaconstant(expjrue) 

varsjn(exp,  cons(expl)))  *■  itsavar(exptrue) 

varsjnf  cons(  name  at  (list),  varllst) «-  varslnllst(argllst,  varllst). 
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function  varslnllst 
Input  pattern f (1  0) 
parameter  list} 
varslnlist((),  ()) 

varslnllst(cons(sJ),  varlist) «-  varsjn(x,  varllstl), 

varsinlist(l,  varlist  2),  appends  (varlist  1,  varlist  2,  varlist). 


function  itsaconstant 
Input  pattern t (I  0) 
parameter  list} 

ltsaconstant(x,  true)  *■  itsanumber(x,  true) 
itsaconstant( cons( ' quote t),  true ) 
Itsaconstantft,  true) 
itsaconstant('undef,  true) 
ttsaconstant((),  true) 

ItsaconstantC false,  true) 
ItsaconstantCtrue,  true) 

ItsaconstantCf,  true) 

Itsaconstantfx,  true) «-  is-strlng(x). 

function  Itsanumber 
Input  pattern f (l  0) 
parameter  list } 
tlsanumber(xjrue)  *■  real(x) 

Itsanumberfx,  true) «-  integer(x). 

function  Usavar 

Input  pattern}  (I  0) 

parameter  list} 

ltsavar(cons(  xy),  false) 

ltsvar(exp,  true)  ttsaconstantfexp,  false). 


function  appendt 
Input  pattern}  (110) 
parameter  list} 
appendtfxl )*) 
appendSf  (),  x.  x) 

appendS(cons(xJI),  12,  cons(xj))) «-  appendSUl,  12, 13). 


function  choose-fun 
Input  pattern}  (110) 
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paramtttr  Ustt 

choost-fiin(  Inpat,  cons( patttrn,  cons(fnami,  tils)),  f name)  *- 
inuf-known(inpat,  patttrn,  trut) 
choost-f un(lnpat,  const  patttrn,  consonant  jtlt)),  funnant)  *■ 
choost-f unfinpat,  stls.funnant) 
choost-f un(inpat,  (),  undtf). 


function  tnuf-knoum 
Input  pattern}  (1 1 0) 
paramtttr  list} 
tnuf-known((),  (),  trut) 

tnuf-known(cons(IJ),  cons(xX),  ans)  - tnuf-knoum(lXAns) 
tnuf-k  nown( cons(Ot),  const IX),  foist). 


function  mk.pat 

input  pattern}  (1 1 0) 

paramtttr  list} 

mk^patt  (),  knou/nvars,  ()) 

mk^patt  const  are)),  knoumvars,  const  IX))  *■ 

is-knoumjarg,  knou/nvars,  trut),  mk.pottt,  knou/nvars,  k) 
mk^pat(constarg)),  knou/nvars,  cons(OX))  *■  mk_pat(l,  knou/nvars,  k). 


function  is-known 
input  patttrn}  (I  I 0) 
parameter  list} 

is-knowntx,  knou/nvars,  trut)  *■  itsaconstant(x)rut) 
is-knoun(constf)),  knou/nvars  Ans) «-  knoun-llst(l,  knoumvars,  ans) 
is-knownfx,  knou/nvars,  ans) «-  mtmber(x,  knou/nvars,  ans). 


function  knounlist 
input  pattern}  (l  I 0) 
paramtttr  list} 

knonin-list(t),  knoumvars,  trut) 

hnown-llst(cons(xJ),  knoumvars,  trut)  *■  ls-knoan(x,  knou/nvars,  true), 
knou/n-list(  IXnouinvar  strut). 
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function  type-spec 
Input  pattern f (110  0) 
parameter  list f 
typ*-spec(  speefildenv, 

list('type,name!(l  0),  '(x  y),  T.  ’( boolean  y)i>ody),  neuenv)  «- 
flrstsym(spec,  name,  morel), 
aAd-type(oldenv,  name,  neuenv), 
urite("bodyf"), 

is-body(morel,  body,  morex,  undef,  neuenv,  ’(1 0)). 


function  add-type 
input  pattern f (110) 
parameter  list? 

add-type(  llst(  generics  functions  types),  name, 

list(  generics  functions,  cons(nametypes))). 


function  gen-spec 
input  pattern f (110  0) 
parameter  llstf 
gen-spec(spec,  oldenv, 

cons(list(' generic,  n«m#,  params,  selections),  defllst),  neuenv)  *• 
fir stsym( spec,  name,  morel). 

uriteC parameter  list?"),  firstexp(morel , params,  more2), 
urtteC‘choicesf"),firstsym(more2,  nxtsym,  more 2), 
rd-choices(nxtsym,  more),  choicellst,  bodylist,  morei), 
add- gen( oldenv,  name,  choicellst,  neuenv), 
repeats-of(bodylist,  rep-bodnams), 
urlte('body-defs:m), 

rd-bodles(more4,  choicellst,  (),(),  params,  rep-bodnams,  neuenv, 
defllst,  morex). 


function  rd-cholces 
Input  pattern f (1  10  0 0) 
parameter  llstf 

rd-chdcesCl.,  spec,  (),  (),  more) 

rd-choicesCK,  spec,  cons( Ust( Inpat, name, precond.postcondpodnam),  choicellst), 
consf bodnamjbodyllst),  more)  «- 
flrstsymfspec,  nxtsym,  spec2), 

readlnpatf  nxtsym,  spec2,  Inpat,  morel),  urite(Kfunctt$n  name/T), 
fir st sym( morel,  name,  more2),  urltef'precondltlonT ), 
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ls-disJunct(more2,  precond,  more}), 
mlte(mpostconditionV'), 
ls-disjunct(more3,  postcond,  more4), 
witel'body  name?’), 
firstsym(more4,  bodnam,  morei), 
wrlteCchoices?"),  flrstsym( morei,  chsym,  more6), 
rd-cholces(chsym,  more6,  cholctlltt,  bodyllst,  more). 


function  readinpat 
input  pattern 7 (110  0) 
parameter  list t 
readinpat(’l),  spec,  (),  spec) 
readinpat(  digit,  spec,  cons(digit,  restinpat),  more)  ► 
fir  stsym(  spec,  nxtsym,  morel), 
readinpatfnxtsym,  morel,  restinpat,  more). 


function  rd-bodies 

input  pattern 7 (11111110  0) 

parameter  listf 

rd-bodies(spec,  (),  rep-bodies,  donelist,  params,  rep-bodnams,  env,  (),  spec) 
rd-bodies( spec,  cons( listfinpat, name, precond, postcond Jtotnam),  cholcelist), 
rep-bodies,  donelist,  params,  rep-bodnams  /no, 
cons(list(\ function; namejnpat,' params, t precond, postcondhody),  defllst), 
more)  *- 

not-ln( bodnam,  donelist),  not-in(bodnamrep-bodnams), 
write(bodnam),  witeCV), 
is-body(spec,  body,  morel,  false,  env,  inpat), 
rd-bodies(morel,  choicelist,  rep-bodies,  cons(bodnamAonellst),  params, 
rep-bodnams,  env,  deflist,  more) 

rd-bodies(spec,  cons(list(lnpat, name. precond, postcondbodnam),  choicelist), 
rep-bodies,  donelist,  params,  rep-bodnams /np, 
cons(list(’ function, namelnpat, params, precond, postcondPody),deflLt), 
more)  *■ 

member(bodnamAoneUstfrue), 
getbfbodnam,  rep-bodies,  genbody), 
spec-body(lnpat,  env,  genbody,  body) 

rd-bodles(spec,  cons(list(inpat,namt. precond, postcondjsodnam),  choicelist), 
cons(cons(bodnam  genbody)  rep-bodies),  donelist,  params, 
rep-bodnams/nv, 

cons(ltst(  f unction, namejnpat, params, precond,postcondjbody),  deflist), 
more)  *■ 


mm 
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n ot-in(bodnam,  dontllst),  memberfbodnam,  rtp-bodnams,  tnu), 
uriitfbednam),  writti'T), 
ls-body(sptc,  gtnbody,  mortl,  trut,  tnv,  inpat), 
sptc-body(lnpat,  tnv,  gtnbody,  body). 


function  gttb 
input  patttrnf  (1  1 0) 
parameter  llstf 

getb(bodnam,  cons(cons(bodnam, gtnbody),  rep~bodits),  gtnbody) 
gttb(bodnam,  cons(xjrtpbodits),  gtnbody)  *■ 
getbfbodnam,  rtpbodits,  gtnbody). 


function  sptc-body 
Input  patttrnf  (1110) 
parameter  Ust T 

spec-body(tnpat,  tnv,  cons(‘bktrkcond,  gtnalttrnativts), 
cons('bktrkcond,  alttrnativts) ) - 
sptc-alts(inpat,  tnv,  gtnalttrnativts,  alttrnativts). 


function  spec-alts 
input  pattern T (1 1 1 0) 
parameter  list? 
sptc-alts(inpat,  tnv,  (),  ()) 

s pec-alt  s(  in  pat,  tnv,  cons(gtnmatch-try-pair,  gtnalttrnativts), 
cons(match-try-pair,  alttrnativts))  *■ 
spec-claust(inpat,  tnv,  gtnmatch-try-polr,  match-try-palr), 
s pec-alt sfinpat,  tnv,  gtnalttrnativts,  alternatives). 


function  sptc-claust 
input  patttrnf  (1110) 
parameter  listf 

sptc-claust(inpat,  tnv,  listfarglist,  cons(’try^tnllst)), 
listfarglist,  cons('tryjbllst)))  *- 
mk-known(lnpat,  argllst,  (),  knownvars), 
sptc-goalistigtnlist,  tnv,  knownvars,  sblist). 
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function  spec-goalist 
input  pattern t (1110) 
parameter  list t 

spec-goalist((),  env,  knownvars,  ()) 
spec-goallst(cons(  cons(namej),  genlist),  env,  knownvars, 
cons(  cons(nameJ)jblist))  *- 
generic( name,  env,  undef), 
mk-allknown(l,  knownvars,  newknownvars), 
s pec- goalistf genlist,  env,  newknownvars,  sblist ) 
spec-goalist(cons(cons(gennameftrglist),  genlist),  env,  knownvars, 
cons(cons(nameflrglist),  sblist))  ♦* 
generlcfgenname,  env,  selections), 
mk..pat(arglist,  knownvars,  inpat), 
choose-funjinpat,  selections,  name), 
mk~allknown(arglistMownvars,  newknownvars),  / 
s pec- goalistf genlist,  env,  newkownvars,  sblist). 


function  trans 
input  pattern?  (1110) 
parameter  list ? 

trans(Ust(  'function,  name,  inpat,  params,  precond,  postcond, 
cons(’bktrkcond,  alternatives)),  env,  'lisp, 
list(  'defun,  name,  fexpr, '( l ), 

list(  ' cond  list(  listCtrueprecond/istCcons, 

listC quote,  name) 

m 

list(’bktrkcond,  ’l,  listC quote, 

alternatives))), 


’(t  'undef))) ). 
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Appendix  G Listing  of  the  System 

I 

% 


The  following  listing  is  the  actual  program  that  is  read  into  MACLSP. 

The  semi-colon  indicates  that  everything  until  the  next  carriage-return  is  to 
be  taken  as  a comment. 

;top  level 
(def  top  0 

(prog  (you-want-to-save) 

; the  next  two  lines  should  eventually  be  deleted,  they  make  LISP  the  default  language 
(setq  target  ’lisp) 

(makedefs  (get  'lisp  ’primdefs)) 

(setq  namelist  ()) 

(setq  inflag  t) 

(setq  prim-types  '(integer  real  boolean  is-string  is-list)) 

(princ  'IHello,  this  Is  a program  synthesis  system  which  takes  logic/ 
specifications  as  input  and  generates  a program  in  the  target/ 
language  of  your  choice./ 

(Right  now  that  choice  is  limited  to  LISP  and  maybe  PASCAL).  / 

/ 

If  you  wish  the  output  to  go  to  a file,  please  give  me  the  name/ 
of  that  file;  if  not,  just  hit  carriage-return/ 

D 

(readchXreadch) 

((lambda  (filename) 

(cond  ((eq  filename  carrlage_return)  (setq  outflag  nil)) 
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(t  (setq  outputfile  (read)) 

(uwrite  dsk  (J  red)) 

(setq  outflag  t) 

(setq  r t)))) 

(tyipeek)) 

(princ  '|/ 

If  you  wish  me  to  read  specifications  from  a file  you've  created,/ 
then  please  give  me  the  name  of  the  file;  if  this  session  is  to  be/ 
interactive,  then  just  hit  carriage-return/ 

I) 

(readchXreadch) 

((lambda  (filename) 

(cond  ((eq  filename  carriagejreturn)  (setq  inflag  nil)  (princ  '| / 
If  you  need  help  getting  started,  type  TV 
I 

0) 

(t  (setq  filename  (read)) 

(setq  inflag  t) 

(eval  (list  'eread  filename)) 

(setq  <1  t)))) 

(tyipeek)) 

(setq  nxtsym  (ratom)) 

(do  ()  ((not  (is.definition))  (print  ’alldone)) 

(setq  namelist  (cons  name  namelist)) 

(putprop  name  params  'params) 

(putprop  name  precond  'precond) 

(putprop  name  inpat  'inpat) 

(putprop  name  postcond  ’postcond) 

(putprop  name  body  ’body) 

((lambda  (x)  (cond  ((eq  target  'lisp) 

(eval  x)  (eval  (list  'grindef  name))) 

(t  (unlist  x)))) 

(translate  name  target)) 

(terpri) 

(terprl) 

(setq  nxtsym  (ratom))) 

(cond  (outflag 

(eval  (list  'ufile  outputfile  ’gen)))) 

(princ  '1/ 

Do  you  want  to  save  these  internalised  specifications  on  a file?/ 

If  not,  just  hit  carriage  return...  D 
(readch) 

(readch) 

(setq  nxtsym  (tyipeek)) 


t 
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(cond  ((not  (or  (eq  nxtiym  carriage_retuft?)  (eq  nxuym  tn))) 

(setq  you-want-to-save  t)  (tetq  nxuym  (read))))  ;you-want-to-save 
(cond  (you-want-to-save  (prlnc  ’| / 

on  what  file?/ 1)  ;is  initialized  to 

;nil  as  prog  var 

((lambda  (nam) 

(dumpdefs  namelist  nam) 

(princ  ’| / 

Whenever  you  want  to  start  the  system  up  with  these/ 
functions  already  defined  as  they  were  in  this  session,/ 
type/ 

“(include  |) 

(princ  namXprinc  ’07 

then  type/ 

"<top)7 

Actually  the  call  on  include  can  take  any  number  of / 
filenames  that  you  wish  to  include.!)) 

(read))) 

(t  (princ  'I / 
nothing  saved/ 

I))) 

(princ  V 

We  now  turn  control  back  over  to  the  top  level  of  LISP.  / 

If  you  wish  to  start  over  type  "(top)*/ 

D)> 


(def  is_definition  () 

(do  (X(not  (eq  nxtsym  7))) 

(princ  ’| / 

To  specify  the  target  language  type:/ 

"target  <language-name>*/ 

/ 

To  specify  a function  definition  type:/ 

"function  <name>7 

followed  by  the  rest  of  the  specification.  You  will  be  asked  for  each / 
part  of  the  specification;  if  you  don’t  know  how  to  answer,/ 
type  “?"  for  help./ 

/ 

To  specify  a generic  function  definition  type:/ 

“generic  <name>*/ 

followed  by  the  rest  of  the  specification.  You  will  be  asked  for  each / 
part  of  the  specification;  if  you  don’t  know  how  to  answer,/ 
type  “?"  for  help./ 


To  specify  a data  type  type/ 


MRM M 


r 

% 


f 

I 


I 

I 

i 

I 
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"type  <name>"/ 

followed  by  the  rest  of  the  specification.  You  will  be  asked  for  each/ 
part  of  the  specification;  if  you  don't  know  how  to  answer,/ 
type "?"  for  help./ 

/ 

To  conclude  the  session  type  a period  ".7 

I) 

(terpri) 

(setq  nxtsym  (ratom))) 

(setq  genrlflag  nil) 

(cond  ((is.fundef)  (setq  name  fnameXputprop  fname  t ’function)) 
((is-gendefXsetq  nxtsym  (ratom))  (is_defimtion)) 

((is-typedef)  (setq  name  typenameXputprop  name  t ’type)) 

((eq  nxtsym  'targetXnewtargetXsetq  nxtsym  (ratom)Xis_definitlon)) 
((eq  nxtsym  ’/.)  nil) 

(t  (error  ’(bad  start  (or  finish))  nxtsym)))) 

(def  newtarget  () 

(setq  target  (ratom)) 

(cond  ((eq  target  ’lisp) 

(setq  deflist  (get  target  ’primdefs)) 

(makedefs  deflist)))) 

(def  makedefs  (dl)  (cond  ((null  dl)  t) 

(t  (eval  (first  dl))  (makedefs  (rest  dl))))) 


(def  dumpdefs  (namelist  filename) 

(uwrlte) 

(setq  r t) 

(setq  w t) 

(do  ((names  namelist  (rest  names))) 

((null  names)) 

(prog  (name) 

(setq  name  (first  names)) 

(print  (list  'putprop  (list  ’quote  name) 

(list  'quote  (get  name  ’params)) 
"params)) 

(print  (list  'putprop  (list  'quote  name) 

(list  'quote  (get  name  ’precond)) 
"precond)) 

(print  (list  'putprop  (list  'quote  name) 

(list  'quote  (get  name  'postcond)) 
"postcond)) 

(print  (list  'putorop  (list  'quote  name) 

(list  'quote  (get  name  ’inpat)) 
"inpat)) 

(print  (list  ‘putorop  (list  'quote  name) 

(list  'quote  (get  name  *body)) 


•j*s*m* : 


a 
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"body)) 

(print  (list  ’putprop  (list  'quote  name) 
(list  'quote  (get  name  ’fexpr)) 
"fexpr)) 

))  .end  of  prog  and  do 

(print  "*eof*) 

(eval  (list  'ufile  filename  ’ext)) 

(setq  w nil)) 


(def  include  fexpr  (flnames) 

(cond  ((null  flnames)  ’all-done) 

(t  (eval  (list  'eread  (first  flnames)  'ext)) 

(setq  <1  t) 

(do  ((x  nil  (eval  (read)))) 

((eq  x Veof*))) 

(eval  (cons  'include  (rest  flnames)))))) 


(def  unlist  (I)  (do  ((dumplist  I (rest  dumplist)))  ;this  is  for  printing  out 

((null  dumplist))  programs  that  were  generated 

(princ  (first  dumplist)))) 


1 
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| .i 


;stuff  needed  all  over 


(putprop  'def  (get  'defun  ’fiubr)  ’fsubr) 
(setq  tn  156) 

(setq  rpg-bug  315) 

(tetq  ? 77) 

(setq  tab  1 1) 

(setq  period  56) 

(setq  doliar-sign  44) 

(setq  hot-cross-bun  26) 

(setq  comma  54) 

(setq  back-arrow  137) 

(setq  or-sym  37) 

(setq  and-sym  4) 

(setq  Ipar  50) 

(setq  rpar  51) 

(setq  space  40) 

(setq  carriage  .return  15) 

(setq  linefeed  12) 


(def  ls_funapp  () 

(prog  (fname  arglist)  (return 
(cond  ((eq  (typep  nxtsym)  ’symbol)  (setq  fname  nxtsym) 

(cond  ((eq  (setq  nxtsym  (ratom)) ’/( ) 
(setq  nxtsym  (ratom)) 

(setq  arglist  (formalize 

(readargs))) 

( makejunapp  fname  argliu)) 

(t  (error  ’(missing  arglist)  nxtsym)))) 
(t  (error  '(funapp  with  bad  function  name)  nxtsym)))))) 


I 


mo  Infix  function  applications  are  allowed  in  this  version 


(def  readargs  () 

(prog  (arg) 

(cond  ((eq  nxtsym  7.)  (setq  nxtsym  (ratom)))) 

(return  (cond  ((eq  nxtsym  7) ) (setq  nxtsym  (ratom))  ()) 

((eq  (tyipeek)  Ipar)  (cons  (is_funapp)  (readargs))) 

((eq  nxtsym  70  (cond  ((eq  (setq  nxtsym  (ratom)) '/)) 

(setq  arg  ()) 

(setq  nxtsym  (ratom)) 

(cons  arg  (readargs))) 

(t  (error  '(unquoted  non-empty  list  as  arg)nxtsym)))) 
((atom  nxtsym)  (setq  arg  nxtsym)  (setq  nxtsym  (ratom)) 
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(cons  arg  (readargs))) 

«eq  (first  nxtsym)  ’quote)  (setq  arg  nxtsym)  (setq  nxtsym  (ratom)) 
(cons  arg  (readargs))) 

((eq  (first  nxtsym)  ’string)  (setq  arg  nxtsym)  (setq  nxtsym  (ratom)) 
(cons  arg  (readargs))) 

(t  (error  ’(weird  argument)  nxtsym)))))) 


(def  make.funapp  (x  y)  (cons  x y)) 

(def  ratom  ()  (setq  nxtsym  (tyipeek)) 

(do  0 ((not  (or  (eq  nxtsym  space)  (eq  nxtsym  lineJeed) 

(eq  nxtsym  tab)  (eq  nxtsym  carriage_return)))) 

(setq  nxtsym  (readch)) 

(setq  nxtsym  (tyipeek))) 

(cond  ((or  (eq  nxtsym  comma)  (eq  nxtsym  back-arrow)  (eq  nxtsym  period) 
(eq  nxtsym  or-sym)  (eq  nxtsym  and-sym) 

(eq  nxtsym  Ipar)  (eq  nxtsym  rpar))  (setq  nxtsym  (readch))) 

(t  (setq  nxtsym  (read)) 

(cond  ((eq  nxtsym  ’true)  t) 

((eq  nxtsym  ’f)  ’false) 

(t  nxtsym))))) 

(def  first  (x)  (car  x)) 

(def  second  (x)  (cadr  x» 


(def  third  (x)  (caddr  x)) 
(def  rest  (x)  (edr  x)) 
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;The  following  programs  accomplish  the  interactive  input  of  function,  type, 
;and  generic  definitions.  They  are  much  longer  than  need  be  due  to  the 
;voluminous  help  Information. 

(def  is_fundef  () 

(cond  ( (eq  nxtsym  'function) 

(setq  fname  (read)) 

(prlnc  '| / 
input  pattern?  |) 

(setq  nxtsym  (tyipeek)) 

(do  0 ((not  (eq  nxtsym  ?))) 

(setq  nxtsym  (readch)) 

(princ  V 

/ 

The  input  pattern  is  a list  of  I's  and  0's  (optionally  separated  / 
by  commas)  indicating  which  of  the  parameters  are  to  be  considered/ 
input  (values  available  on  procedure  call)  and  which  are  output/ 

(values  to  be  computed)/,  respectively.  For  example/,/ 

*0/.  1/,  0)7 

indicates  that  the  last  parameter  is  thought  of  as  a function/ 
of  the  first  two  parameters./ 

/ 

input  pattern?  |) 

(setq  nxtsym  (tyipeek))) 

(setq  inpat  (read)) 

(princ  V 

parameter  list?/ 1) 

(readchXreadch) 

(setq  nxtsym  (tyipeek)) 

(do  ()  ((not  (or  (eq  nxtsym  space) ))) 

(setq  nxtsym  (readch))  (setq  nxtsym  (tyipeek))) 

(do  (X(not  (eq  nxtsym  ?))Xsetq  nxtsym  (readch)) 

(princ  V 

the  parameter  list  is  a list  of  variables,  enclosed  in  parentheses,/ 
and  optionally  separated  by  commas.  / 

For  example,  "(x  I,  x2.  x3)’  |) 

(terpriXprinc  V 

parameter  list?/ 1) 

(cond  ((not  inflag)  (readchXreadch))) 

(setq  nxtsym  (tyipeek)) 

(do  ()  ((not  (or  (eq  nxtsym  space) ))) 

(setq  nxtsym  (readch))  (setq  nxtsym  (tyipeek)))) 

(cond  ((eq  nxtsym  carriage j-eturn) 

(setq  params  (make-up-args  inpat)) 

(setq  precond  t) 

(setq  postcond  t) 


! 


i 


< 


v 


T 
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(princ  '1 / 

you've  Just  defaulted  on  formal  parameters,  precondition,/ 
and  postcondition,  you  know  that  really  is  not  a good  ideaV 
/ 

body?  D) 

((eq  nxtsym  Ipar) 

(setq  params  (formalize  (read)}) 

(princ ']) 

precond?/  |) 

(setq  nxtsym  (ratom)) 

(do  (X(not  (eq  nxtsym  ’?))) 

(princ  '1/ 

a precondition  is  a disjunction,  which  expresses  a condition  / 
or  domain  over  which  the  function  being  defined  is  guaranteed/ 
to  terminate.  The  disjunction  must  be  terminated  by  a period.!)  (terpri) 
(princ  5|  / 

domain-spec  disjunction  *."/ 

I 

disjunction  conjunction  /|  disjunction  V conjunction  / 

/ 

conjunction  literal  /|  conjunction  V literal  / 

I 

literal  atomic-formula  /|  V atomic-formula  / 

I 

atomic-formula  "true"  /|  fun-app  / 1 "("  disjunction  ")"  / 

I 

fun-app  name  arglist  / 

/ 

arglist "( )"  /| "("  args  ")"/ 

I 

args  arg  / 1 arg  ","  args  / 

/ 

arg  identifier  / 1 number  /|  fun-app  I 

For  example,  *integer(x  l,y)  a grtr-eq(x  1.0, z)*  / 

Don't  forget  to  include  the  output  variables,  in  this  case  y and  t. 

I) 

(terpriXterpriXprinc  'Iprecond?  0 
(setq  nxtsym  (ratom))) 

(setq  precond  (readspec)} 

(princ  '1 1 

postcond?/  D 

(setq  nxtsym  (ratom)} 

(do  (X(not  (eq  nxtsym  *?))) 

(princ '!/ 


1 ' 
I 
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A postcondition  is  a disjunction,  which  expresses  a condition  / 
guaranteed  to  be  true  of  the  output  variables.  It  might  also / 
be  considered  as  a specification  of  the  range  of  the  functlon.0 
(princ  ’|  / 

range-spec disjunction  ".*/ 

/ 

disjunction  conjunction  /|  disjunction  V conjunction  / 

I 

conjunction  literal  /|  conjunction  V literal  / 

/ 

literal  atomic-formula  /| atomic-formula  / 

/ 

atomic-formula  "true"  /|  fun-app  / 1 T disjunction  T / 

/ 

fun-app  name  arglist  / 

I 

arglist  n-  “( )’  / 1 "("  args  T I 

I 

args  s»  arg  / 1 arg  V args  / 

I 

arg  identifier  /|  number  /|  fun-app  / 

/ 

For  example,  ’integer(y,i)  a grtrfy.O^)"  / 

(remember  the  output  variables!)/ 

0 


postcond?/  0 


(terpriXprinc  ’| I 


(setq  nxtsym  (ratom))) 

(setq  postcond  (readspec)) 

(princ  *1/ 

body?/  0) 

(t  (error  ’(no  7C  seen  when  asking  for  parameters)  nxtsym))) 
(setq  nxtsym  (ratom)) 

(do  (X(not  (eq  nxtsym  7))) 

(princ  V 

A function  body  is  a set  of  horn  clauses,  terminated  by  a period V 


body horn-clauses  ".7 

/ 


horn-clauses  h -clause  / 1 h-clause  horn-clauses/ 

/ 

h-clause  goal  V subgoals  /I  goal/ 
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I 


goal fun-app/ 
/ 


subgoals  fun-app  /|  fun-app  V subgoals/ 

/ 

fun-app  name  arglist  / 

/ 

For  example/ 

/ 

fact(O.l)/ 

fact(n,z)  *■  subl(n,x),  fact(x,zl),  time$(n,zl,z)/ 

I) 


body?/  D 

(t  nil))) 


(terpriXprinc  *| / 

(setq  nxuym  (ratom))) 
(setq  body  (repdauses))) 


(def  make-up-args  (list) 

(cond  ((null  list)  ()) 

(t  (cons  (gensym)  (make-up-args  (rest  list)))))) 


(def  is-gendef  () 

(prog  (specs  gname  params  bodies-pair) 

(return 

(cond  ( (eq  nxtsym  ’generic) 

(setq  gname  (read)) 

(princ  V 

parameter  list?/  |) 

(setq  nxtsym  (tyipeek)) 

(do  ()  ((not  (or  (eq  nxtsym  space)  (eq  nxtsym  linejeed) 
(eq  nxtsym  carrlage_return)))) 

(setq  nxtsym  (readch))  (setq  nxtsym  (tyipeek))) 
(do  (X(not  (eq  nxuym  ?))Xsetq  nxuym  (readch)) 

(princ  V 

the  parameter  list  is  a list  of  variables,  enclosed  in  parentheses,/ 
and  optionally  separated  by  commas.  / 

For  example,  "(x  I,  x2,  x3)*  0 
(terpriXprinc  '|/ 

parameter  list?/  D 

(setq  nxuym  (tyipeek)) 

(do  0 ((not  (or  (eq  nxuym  space)  (eq  nxuym  line  Joed) 
(eq  nxtsym  carriage_rctum)))) 

(setq  nxuym  (readch))  (setq  nxuym  (tyipeek)))) 
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(setq  params  (formalize  (read))) 

(princ  *1/ 

choice*?  |) 

(setq  nxtsym  (tytpeek)) 

(do  ()  ((not  (or  (eq  nxtsym  space)  (eq  nxtsym  lineJced) 

(eq  nxtsym  carriagejreturn)))) 

(setq  nxtsym  (readch))  (setq  nxtsym  (tyipeek))) 

(do  (X(not  (eq  nxtsym  ?))X*etq  nxtsym  (readch)) 

(princ  V 

a choice  consists  of  an  input  pattern,  function-name,  precondition,  postcondition, 
and  body-name.  Just  give  the  input  pattern  and  the  system  wilt  ask  you  for  the 
rest/ 

/ 

/ 

if  there  are  no  more  choices  to  be  entered  type  "7 

/ 

choices?  I) 

(setq  nxtsym  (tyipeek)) 

(do  ()  ((not  (or  (eq  nxuym  space)  (eq  nxtsvm  linefeed) 

(eq  nxtsym  carriage_return)))) 

(setq  nxtsym  (readch))  (setq  nxtsym  (tyipeek)))) 

(prog  (fun-name  inpat  precond  postcond  body-name) 

(setq  specs 

(do  ( (selections  ()  (cons  (cons  inpat  fun-name)  selections)) 

(flag  0 0)  ;flag  tells  whether  fun-name  is  new 

(bodies  ()  (cond  (flag  (cons  body-name  bodies)) 

(t  bodies))) 

(fun-names  ()  (cond  (flag 

(cons  fun-name  fun-names)) 

(t  fun-names))) ) 

( (eq  nxtsym  period) 

(setq  nxtsym  (ratom)) 

(cons  selections  (cons  bodies  fun-names)) ) 

(setq  inpat  (read)) 

(princ  V 

function  name?  D 

(setq  nxtsym  (tyipeek)) 

(do  ()  ((not  (or  (eq  nxtsym  space)  (eq  nxtsvm  linefeed) 

(eq  nxtsym  carriage_return)))) 

(setq  nxtsym  (readch))  (setq  nxtsym  (tyipeek))) 

(do  (X(not  (eq  nxuym  ?))X**tq  nxtsym  (readch)) 

(princ  V 

this  is  the  name  the  system  will  use  to  define  a function  with  the  given  input 
pattern,  to  be  called  whenever  a generic  call  is  made  which  fitt  the  input- 
pattern/ 

/ 


1 
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function  name?  |) 

(setq  nxtiym  (tyioeek)) 

(do  ()  ((not  (or  (eq  nxtsym  space)  (eq  nxtsym  linefeed) 

(eq  nxtsym  carriage_return)))) 

(setq  nxtsym  (readch))  (setq  nxtsym  (tyipeek)))) 

(setq  fun-name  (read)) 

(cond 

((get  fun-name  ’body)  nil);if  it  is  already  defined,  do  nothing 
((eq 't  (first  (explode  fun-name))) 

(autopred  fun-name  params)>,  if  system  function,  autopred  it 
(t  .-otherwise,  get  the  rest  of  the  info 

(setq  flag  t) 

(putprop  fun-name  inpat  'inpat) 

(putprop  fun-name  params  ’params) 

(princ  'I / 

precond  ?/  D 

(setq  nxtsym  (ratom)) 

(cond  ((eq  nxtsym  ’precond?)  (setq  nxtsym  (ratom)))) 

(do  (X(not  (eq  nxtsym  '?))) 

(princ  '1/ 

a precondition  is  a disjunction,  which  expresses  a condition  / 
or  domain  over  which  the  function  being  defined  is  guaranteed/ 
to  terminate.  The  disjunction  must  be  terminated  by  a period.))  (terpri) 

(princ  ’I  / 

domain-spec disjunction  "."/ 

/ 

disjunction  conjunction  /|  disjunction  V conjunction  / 

I 

conjunction  literal  /|  conjunction  V literal  / 

/ 

literal  atomic-formula  /|  atomic-formula  / 

/ 

atomic-formula  :>  "true"  /|  fun-app  / 1 "("  disjunction  ")"  / 

fun-app  name  arglist  / 

I 

arglist "( )"  /|  "("  args  T / 

/ 

args  :>  arg  / 1 arg  ","  args  / 

/ 

arg  identifier  /|  number  / 1 fun-app  / 

For  example,  "integer(x  l,y)  a grtr-eq(x  1,0, i)"  / 

Don't  forget  to  include  the  output  variables,  in  this  case  y and  x. 

D 


x*,.  fr 
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(terpriXterpriXprinc  ’precond? ) 

(setq  nxtsym  (ratom)) 

(cond  ((eq  nxtjym  ’precond?)  (setq  nxtsym 
(ratom))))) 

(setq  precond  (readspec))  (putprop  fun-name  precond  ‘precond) 

(princ  V 

postcond?/ 1) 

(setq  nxtsym  (ratom)) 

(cond  ((eq  nxtsym  ’postcond?)  (setq  nxtsym  (ratom)))) 

(do  (X(not  (eq  nxtsym  *?))) 

(princ  ’| / 

A postcondition  is  a disjunction,  which  expresses  a condition  / 
guaranteed  to  be  true  of  the  output  variables.  It  might  also / 
be  considered  as  a specification  of  the  range  of  the  function.D 
(princ  'I  / 

range-spec  disjunction  "."/ 

/ 

disjunction  conjunction  /|  disjunction  V conjunction  / 

/ 

conjunction  literal  / 1 conjunction  V literal  / 

I 

literal atomic-formula  /|  V atomic-formula  / 

/ 

atomic-formula  “true"  /|  fun-app  /| "("  disjunction  *)“  / 

/ 

fun-app  name  arglist  / 

I 

arglist “( )“  / 1 “(“  args  ")7 
/ 

args  -■  arg  /|  arg  args  / 

I 

arg  identifier  /|  number  / 1 fun-app  / 

I 

For  example,  “integer(y^)  a grtr(y,0,z)"  / 

(remember  the  output  variables!)/ 

D 


postcond?/ 1) 


(terpriXprinc  ’| I 


(setq  nxtsym  (ratom)) 

(cond  ((eq  nxtsym  ’postcond?) 

(setq  nxtsym  (ratom))))) 

(setq  postcond  (readspec))  (putprop  fun-name  postcond  ’postcond) 
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(prlnc  '| / 
body-name?  |) 

(cond  ((not  inflag)  (ratom))) 

(setq  nxesym  (ratom)) 

(do  (X(not  (eq  nxtsym  ’?))) 

(princ  ’1 / 

this  it  the  name  which  associate!  the  proper  body  definition  with  the  function 
being  defined/ 

/ 

body-name?/ 1) 

(cond  ((not  inflag)  (ratom))) 

(setq  nxtsym  (ratom))) 

(setq  body-name  nxtsym) 

(putprop  fun-name  body-name  'bodyname) 

));end  of  cond  for  defining  fun-name 

(princ  V 

choices?  I) 

(setq  nxtsym  (tyipeek)) 

(do  ()  ((not  (or  (eq  nxtsym  space)  (eq  nxtsym  linefeed) 

(eq  nxtsym  carriage_return)))) 

(setq  nxtsym  (readch))  (setq  nxtsym  (tyipeek))) 

(do  (X(not  (eq  nxtsym  ?))X$etq  nxtsym  (readch)) 

(princ  ’| / 

a choice  consists  of  an  input  pattern,  function-name,  precondition,  postcondition, 
and  body-name.  Just  give  the  input  pattern  and  the  system  will  ask  you  for  the 
rest/ 

/ 

if  there  are  no  more  choices  to  be  entered  type  *7 

/ 

choices?  0 

(setq  nxtsym  (tyipeek)) 

(do  ()  ((not  (or  (eq  nxtsym  space)  (eq  nxtsym  line_feed) 

(eq  nxtsym  carriage_return)))) 

(setq  nxtsym  (readch))  (setq  nxtsym  (tyipeek)))) 

;end  of  the  Mo”  that  gets  all  the  choices  and  the  setq  of  the  result  of  Mo* 
land  the  pros;  surrounding  it 

(print  (make-gendef  gname  (reverse  (first  specs)))) 

(cond  ((first  (rest  specs)) 

(setq  bodies-pair  (splitbodies  (second  specs)  '((X)) )) 

(setq  namelist  (append  (rest  (rest  specs))  namelist)) 

(princ  V 

body-dcfc0 

(prog  (bodnam  fun-name  genrlflag  genrldef) 

(do  ( (rep-bodies  (second  bodies-pair)  rep-bodies) 

(donebods  ()  (cons  bodnam  donebods)) 
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(fun-names  (reverie  (rest  (rest  specs)))  (rest  fun-names)) 
(rep-defs  ()  (cond  ((and  genrlflag  (not  (member 

bodnam  donebods))) 

(cons  (cons  bodnam  genrldef)  rep-defs)) 

(t  rep-defs))) ) 

((null  fun-names)) 

(setq  fun-name  (first  fun-names)) 

(setq  bodnam  (get  fun-name  'bodyname)) 

(setq  genrlflag  (member  bodnam  rep-bodies)) 

(cond  ((member  bodnam  dor  bods)  (spec-def  fun-name 

(getdef  bodnam  rep-defs))) 

(t 

(terpri) 

(princ  bodnam) 

(princ  'p  |) 

(setq  nxtsym  (tyipeek)) 

(do  ()  ((not  (or  (eq  nxtsym  space)  (eq  nxtsvm  line-feed) 
(eq  nxtsym  carriage-return)))) 

(setq  nxtsym  (readch))  (setq  nxtsym  (tyipeek))) 
(setq  nxtsym  (ratom)) 

(do  (X(not  (eq  nxtsym  1))) 

(princ ']/ 

A function  body  is  a set  of  horn  clauses,  terminated  by  a period./ 

/ 

body  horn-clauses  *.7 

/ 

horn-clauses  h-dause  / 1 h-dause  horn-dauses/ 

/ 

h-dause  goal  V"  subgoals  / 1 goal / 

I 

goal  fun-app/ 

I 

subgoals  fun-app  /|  fun-app  subgoals/ 

/ 

fun-app  :>  name  arglist  / 

/ 

For  example-7 

/ 

fact(0,lV 

fact(n.t)  *-  subl(n,x),  fact(x,il),  times(n,zU)/ 

D 

(terpri) 

(princ  bodnam) 

(princ  'P  D 

(setq  nxtsym  (ratom)) 

(cond  ((eq  nxtsym  (implode  (append 
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(explode  bodnam) 

’(?)))) 

(setq  nxtsym  (ratom))))) 

(setq  Inpat  (get  fun-name  'inpat)) 

(putprop  fun-name 
(cond  (genrlflag 

(setq  genrldef  (repdauses)) 

(spec-def  fun-name  genrldef)) 

(t  (repdauses))) 

’body) ))))  ;end  of  do  collecting  body-defs 
(make-fundefs  (rest  (rest  specs)))))  ;end  of  conditional  on  bodies 
(print  ’end_of_generic_spec)  (terprl)  (terprl) 
t)  ;end  first  clause  of  cond 

(t  nil))))) 


(def  make-gendef  (name  sel-list) 

(putprop  name  sel-list  ’generic)) 

(def  make-fundefs  (fun-names) 

(cond 

((null  fun-names)  t) 

(t 

((lambda  (x)  (eval  x) 

(eval  (list  'grindef  (first  fun-names)))) 
(translate  (first  fun-names)  target)) 

(putprop  (first  fun-names)  t 'function) 

(terpri)  (terpri) 

(make-fundefs  (rest  fun-names))))) 

(def  splitbodles  (bods  ans) 

(cond  ((null  bods)  ans) 

(t  (splitbodles  (rest  bods) 

(checkbod  (first  bods)  ans))))) 

(def  checkbod  (bodnam  uniq-n-repeats) 

(cond  ((member  bodnam  (first  uniq-n-repeats)) 

(list  (first  uniq-n-repeats) 

(cons  bodnam  (second  uniq-n-repeats)))) 

(t  (list  (cons  bodnam  (first  unia-n-repeats)) 
(second  uniq-n-repeats))))) 


(def  getdef  (name  deflist) 

(cond  ((null  deflist)  (error 


((eq  name  (first  (first  deflist; 


’(looking  for  a genrl  definition  that  does  no  exist)  name)) 
st  (first  deflist))) 


eswz 
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(rest  (first  deflist))) 

(t  (getdef  name  (rest  deflist))))) 

(def  spec-def  (fun-name  genrldef) 

(cons  ’bktrkcond  (spec-altlist  (rest  genrldef)  (get  fun-name  'inpat)))) 

(def  ipec-altlist  (genalts  inpat) 

(cond  ((null  genalts)  ()) 

(t  ((lambda  (matchlist) 

(setq  knownvars  (known-of  matchlist  inpat)) 

(cons  (list  matchlist 

(cons  ’try  (spec-goals  (goal-pt  (first  genalts))))) 
(spec-altlist  (rest  genalts)  inpat))) 

(match-pt  (first  genalts)))))) 

(def  goal-pt  (alternative)  (rest  (second  alternative))) 

(def  spec-goals  (gengoals) 

(prog  (tempgoal  choices) 

(return  (cond  ((null  gengoals)  ()) 

((setq  choices 

(is-generic  (setq  tempgoal  (first  gengoals)))) 

(cons  (choosefun  tempgoal  choices) 

(spec-goals  (rest  gengoals)))) 

(t  (cons  tempgoal  (spec-goats  (rest  gengoals)))))))) 

(def  formalize  (argl  1st) 

(cond  ((null  arglist)  ()) 

((is-var  (first  arglist)) 

(cons  (implode  (cons  *1  (explode  (first  arglist)))) 

(formalize  (rest  arglist)))) 

(t  (cons  (first  arglist)  (formalize  (rest  arglist)))))) 


(def  is-typedef  () 

(cond  ((eq  nxtsym  ’type) 

(setq  typename  (read)) 
(terpri) 

(setq  params  ’(!x  !y)) 

(setq  inpat  '(I  0)) 

(setq  precond  t) 

(setq  postcond  '(boolean  !y  t)) 
(princ  '| I 

body?/ 1) 

(setq  nxtsym  (ratom)) 

(do  ()  ((not  (eq  nxtsym  ?))) 
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(princ  ’1 / 

For  a type  definition,  the  input  pattern  is  always  (1  0),  the/ 
precondition  is  true,  and  the  postcondition  is  that  the  output/ 
variable  will  have  a boolean  value./ 


A type  body  is  a set  of  horn  dauses.terminated  by  a / 
period;  It  can  be  considered  as  the  definition  of  a J 
function  to  test  for  membership  in  the  type.  It  / 
always  has  a single  input  variable,  which  can  be  / 
anything,  and  a single  output  variable,  which  is  / 
always  truth-valued./ 


body  horn-clauses 


horn-clauses : 

/ 


1 h-clause  / 1 h-dause  horn-clauses/ 


h-clause  goal  V”  subgoals  / 1 goal / 


goal fun-app/ 


subgoals fun-app  /|  fun-app  subgoals/ 


fun-app  name  argllst  / 


For  example:/ 
tree(empty-tree,y)/ 

treef  graft(tJ,t2),  y)  »•  treeitl.yl),  tree(t2,y2)/ 

(terpriXprinc  ’| / 

body?/ 1) 

(setq  nxtsym  (ratom))) 


(setq  body  (repdauses))) 

<t  nil))) 

(def  put-types  (I) 

(cond  ((null  I)  t) 

(t  (putprop  (first  I)  typename  ’typename) 
(put-types  (rest  I))))) 
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;The  following  programs  are  for  reading  in  precondition  and  postcondition 
specifications 

(def  readspec  0 
(prog  (disj) 

(return  (cond  ((setq  disj  (is.dlsjunct))  disj) 

(t  (error  (specification  is  not  disjunction)  nxtsym)))))) 

(def  is.dlsjunct  () 

(prog  (conjl  conj2)  (return 
(cond  ((setq  conjl  (is.conjunct)) 

(do  ()  ((not  (eq  nxtsym  V))  conjl) 

(setq  nxtsym  (ratom)) 

(cond  ((setq  con J2  (is.conjunct)) 

(setq  conjl  (make.or  conjl  conj2))) 

(t  (error  ’(v  not  followed  by  conjunct)  nxtsym))))) 

(t  (error  ’(no  con junct  to  start  with)  nxtsym)))))) 

(def  make.or  (x  y)  (list  'v  x y)) 

(def  make.and  (x  y)  (list  'a  x y)) 

(def  is.conjunct  () 

(prog  (litl  Iit2)  (return 
(cond  ((setq  lit  I (is .literal)) 

(do  ()  ((not  (eq  nxtsym  ’a))  litl) 

(setq  nxtsym  (ratom)) 

(cond  ((setq  Iit2  (is .literal)) 

(setq  litl  (make.and  litl  Iit2))) 

(t  (error  '(a  not  followed  by  literal)  nxtsym))))) 

(t  (error  '(no  literal  to  start  with)  nxtsym)))))) 

(def  ts.literal  () 

(prog  (atmf)  (return 

(cond  ((or  (eq  nxtsym  t)  (eq  nxtsym  ’true))  (setq  nxtsym  (ratom))  t) 

((eq  nxtsym  '/( ) (setq  nxtsym  (ratom)) 

(cond  ((setq  atmf  (is.dUJunct)) 

(cond  ((eq  nxtsym  7) ) 

(setq  nxtsym  (ratom)) 
atmf) 

(t  (error  ’(missing  right  paren)  nxtsym)))) 
(t  (error  '(no  disjunct  in  parens)  nxtsym)))) 

(t  (isjunapp)))))) 


| 


1 


1 
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;The  following  programs  read  in  and  internalize  Horn  clauses 
(def  repdauses  () 

(cons  'bktrkcond  (read_alternatives))) 

; (cond  ((reg-cond  altlisc)  (cons  'cond  alclist)) 
i (t  (cons  'bktrkcond  altlist)))) 

(def  read.alternatives  () 

(cond  ((eq  nxtsym  ’/.)  ()) 

(t  (cons  (is_alternatlve)  (read_a!ternatlves))))) 

;V  should  only  appear  in  clauses  which  have  something  to  the  right  of  it 
(def  is_alternatlve  () 

(do  (X(not  (eq  nxtsym  '?))) 

(princ  '1/ 

You  are  in  the  midst  of  specifying  the  body,  a horn  clause  is  looked  torj 
Don’t  forget  that  a single-goal  clause  does  NOT  have  V following  the  goaty 
and  the  commas  which  separate  subgoals  are  mandatory./ 

Here  is  a grammar  description:/ 

/ 

horn-clauses  h-dause  /|  h-dause  horn-clauses/ 

/ 

h-dause  goal  V subgoals  /|  goal / 
goal fun-app / 

subgoals fun-app  /( fun-app  subgoals/ 
fun-app  name  arglist  / 

I) 

(terpriXprinc  'j/ 

horn-clause?/ 1) 

(setq  nxtsym  (ratom))) 

(cond  ((setq  goal  (isjunapp)) 

(setq  known-vars  (known-of  (rest  goal)  inpat)) 

(list  (rest  goal)  (makejry  (list_subgoals)))) 

(t  (error  ’(bad  goal)  nxtsym)))) 


(def  known-of  (termlist  pattern) 

(cond  ((null  termlist)  () ) 

((eq  (first  pattern)  1)  (append  (vars-ln  (first  termlist)) 
(known-of  (rest  termlist) 

(rest  pattern)))) 

(t  (known-of  (rest  termlist)  (rest  pattern))))) 
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(def  van-in  (term) 

(cond  ( (atom  term) 

(cond  ((is-var  term) 

(list  term)) 

(t  0 ))  ) 

( t (vars-in-list  (rest  term))))) 


(def  vars-in-iist  (termlist) 

(cond  ((null  termlist)  () ) 

(t  (append  (vars-in  (firtt  termlist)) 

(vars-in-list  (rest  termlist)))))) 


(def  list_subgoals  () 

(prog  (tempgoal  choices) 

(return  (cond  ((eq  nxtsym  V) 

(setq  nxtsym  (ratom)) 

(setq  tempgoal  (is.funapp)) 

(cond  ((and  (not  genrlflag) 

(setq  choices  (is-generic  tempgoal))) 

(cons  (choosefun  tempgoal  choicesXreadjubgoals))) 
((eq  'X  (first  (explode  (first  tempgoal)))) 

(autopred  (first  tempgoal)  (rest  tempgoal)) 
(addoutvars  tempgoal) 

(cons  tempgoal  (readsubgoals))) 

((not  (null  tempgoal)) 

(addoutvars  tempgoal) 

(cons  tempgoal  (read_subgoals))) 

(t  (error  '(subgoal  is  not  a funapp)  nxtsym)))) 

(t  ()))))) 


(def  is-generic  (call)  (get  (first  call)  'generic)) 

(def  addoutvars  (call) 

(do  ((pat  (get  (first  call)  'inpat)  (rest  pat)) 

(varlist  (rest  call)  (rest  varlist))) 

((null  pat)) 

(cond  ((eq  (first  pat)  0) 

(setq  known-vars  (append  (vars-in  (firtt  varlist)) 
known-vars)))))) 


(def  choosefun  (call  choice! ist) 
(prog  (pat  fun) 
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(setq  pat  (mk-pat  (rest  call))) 

(setq  fun  (findfun  pat  cholcelist)) 

(addoutvart  (cons  fun  (rest  call))) 

(return  (cons  fun  (rest  call))))) 

(def  mk-pat  (varlist) 

(cond  ((null  varlist)  () ) 

((is-constant  (first  varlist)) 

(cons  i (mk-pat  (rest  varlist)))) 

((is-var  (first  varlist)) 

(cond  ((memq  (first  varlist)  known-vars) 

(cons  I (mk-pat  (rest  varlist)))) 

(t  (cons  0 (mk-pat  (rest  varlist)))))) 

((all-vars-known  (first  varlist)) 

(cons  I (mk-pat  (rest  varlist)))) 

(t  (cons  0 (mk-pat  (rest  varlist)))))) 

(def  findfun  (key  pairlist) 

(cond  ((null  pairlist) 

(princ  ’|  / 

i can’t  figure  out  which  function  you  want  from  context,  please  help./ 
the  patterns  and  function  names  you've  given  me  are:/ 

D (princ  choicelist)  (princ  ’| / 

known-vars  is:  |)  (princ  known-vars)  (princ  ’(/ 

which  function  do  you  want?  |) 

(read)) 

((as-defined-as  key  (first  (first  pairlist))) 

(rest  (first  pairlist))) 

(t  (findfun  key  (rest  pairlist))))) 


(def  as-defined-as  (pat  I pat2) 

(cond  ((null  pat  1)  t) 

((and  (eq  (first  patl)  0)  (eq  (first  pat2)  1))  nil) 
(t  (as-defined-as  (rest  patl)  (rest  pat2))))) . 


(def  all-vars-known  (exp) 

(cond  ((atom  exp)  (or  (ls-constant  exp) 

(memq  exp  known-vars))) 
(t  (all-vars-in-list-known  (rest  exp))))) 

(def  all-vars-ln-list-known  (I) 

(cond  ((null  I)  t) 

((all-vars-known  (first  I)) 
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(all-vars-in-list-known  (rest  I))) 
(t  nil))) 


(def  make_match  (x  y)  (list  ’match  x y)) 

(def  make_try  (I)  (com  ’try  I)) 

(def  read_subgoals  () 

(prog  (tempgoal  choices) 

(return  (cond  <(eq  nxtsym  ’/,) 

(setq  nxtsym  (ratom)) 

(setq  tempgoal  (isJun app)) 

(cond  ((and  (not  genrlflag) 

(setq  choices  (is-generic  tempgoal))) 

(cons  (choosefun  tempgoal  choicesXread^subgoals))) 
((eq  '1  (first  (explode  (first  tempgoal)))) 

(autopred  (first  tempgoal)  (rest  tempgoal)) 
(addoutvars  tempgoal) 

(cons  tempgoal  (read_subgoals))) 

((not  (null  tempgoal)) 

(addoutvars  tempgoal) 

(cons  tempgoal  (read_subgoals))) 

(t  (error  '(subgoal  is  not  a funapp)  nxtsym);)) 

(t  ()))))) 

(def  Is-constant  (x) 

(cond  ((atom  x)  (or  (numberp  x) 

(eq  x t) 

(eq  x ’f) 

(eq  x ’true) 

(eq  x ’undef) 

(eq  x ’false) 

(eq  x nil))) 

(t  (or  (not  (is-string  x))  (eq  (first  x)  ’quote) 

(not  (contains-var  x)))))) 

(def  is-var  (x)  (and  (atom  x)  (not  (is-constant  x)))) 

(def  contains-var  (exp) 

(cond  ((atom  exp)  (is-var  exp)) 

(t  (list-contains-var  (rest  exp))))) 

;contains-var  ignores  function  names  when  looking  for  variables  since  the  only 
functions  left  in  at  this  point  are  constructors 
(def  list-contains-var  (explist) 

(cond  ((null  explist)  nil) 

((contains-var  (first  explist))  t) 
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;The  following  programs  perform  the  translation  to  target  language 

(def  translate  (name  target) 

(cond  ((eq  target  'lisp) 

(makeJlsp.def)) 

((eq  target  ’pascal) 

(mk-strong-typed) 

(make.pascaLdef)) 

(t  (error  ’(language  not  yet  implemented)  target)))) 

(def  make.lisp.def  ()  (list  ’defun  name  'fexpr  ’(I) 

(list  'cond  (list 

(list  'true-precond  (list  'cons 

(list  'quote 
name) 

’•)) 

(list  'bktrkcond 
’I 

(list  ’quote  (rest  body)))) 

*(t  ’undef)))) 


(def  mk-strong-typed  () 

(make-formal-types  (get  name  ’params)  ;this  function  puts  the  formal  params 
(get  name  ’precond)  ;and  their  types  under  'types,  and 
(get  name  ’postcond)  deletes  the  type  decs  from  the  pre- 
name) ;and  post-conditions,  putting  the 

;resu(ts  under  'typedprecond  and 
;typedpostcond 

(putprop  name  (findprocs  (rest  (get  name  ’body))  name)  ’external-proa) 
(putprop  name  (find-local-types  (rest  (get  name  ’body))  name)  local-dea)) 


(def  make-formal-types  (params  precond  postcond  name) 
((lambda  (split-pre  split-post) 

(putprop  name  (mk-param-types  params 
(append  (first  split-pre) 

(first  split-post))) 

’types) 

(putprop  name  (rest  split-pre)  ’typedprecond) 
(putprop  name  (rest  split-post)  ’typedpostcond)) 
(findtypes  precond) 

(findtypes  postcond))) 
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(def  mk-param-types  (param*  types) 

(cond  ((null  params)  ()) 

(t  ((lambda  (ans) 

(cond  ((defined  ans) 

(cons  ans  (mk-param-types  (rest  parama) 
types))) 

(t  (error  ’(has  no  type  defined)  (first  params))))) 
(lookup  (first  params)  types))))) 


(def  lookup  (var  alist) 

(cond  ((null  alist)  ’undef) 

((eq  var  (first  (first  alist))) 
(rest  (first  alist))) 

(t  (lookup  var  (rest  alist))))) 


(def  findtypes  (precond)  ;returns  the  dotted-pair:  list  of  var-type  pairs, 
(cond  ((atom  precond)  ;and  non-type-dec  part  of  precond 
(cons  0 precond)) 

((is-or  precond) 

(error  '(no  v’s  allowed  in  preconditions  when  translating 
to  strongly  typed  languages)  precond)) 

;if  we  switch  from  dnf  to  enf,  then  we  can  allow  v’s  to  appear 
;in  pre-  and  post-conditions,  but  no  type  decs  may  be  ved,  the 
;alternative  replacing  the  error  above  would  be. 

.•(cons  ()  precond) 

((is-and  precond) 

((lambda  (rest-ansi  rest-ans2) 

(cons  (append  (first  rest-ansi) 

(first  rest-ans2)) 

(list  ’a  (rest  rest-ansi) 

(rest  rest-ans2)))) 

(findtypes  (second  precond)) 

(findtypes  (third  precond)))) 

((is-type  (first  precond))  ;we  know  that  the  first 

(cons  (list  (cons  (second  precond)  ;argument  of  a type 
(first  precond)))  ;app.  is  the  input  var 

T)))) 


(def  is-type  (name) 

(or  (get  name  ’type) 

(memq  name  prim-types))) 
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(def  flndprocs  (alts  name) 

(cond  ((null  alu)  ()) 

(t  (append  (findcalls  (cry-pt  (first  alu))  name) 
(findprocs  (rest  alu)  name))))) 


(def  findcalls  (sbgls  name) 

(cond  ((null  sbgls)  ()) 

(t  ((lambda  (procname) 

(cond  ((eq  procname  name) 

(findcalls  (rest  sbgls)  name)) 

(t  (cons  procname  (findcalls  (rest  sbgls)  name))))) 
(first  (first  sbgls)))))) 


(def  find-local-types  (alts  name) 

(cond  ((null  alu)  ()) 

(t  (append  (findtypesfor  (try-pt  (first  alu))  name) 
(find-local-types  (rest  alu)  name))))) 


(def  findtypesfor  (sbgls  name) 

(cond  ((null  sbgls)  ()) 

(t  ((lambda  (sbel) 

(cond  ((eq  (first  sbgl)  name) 

(findtypesfor  (rest  sbgls)  name)) 

(t  (append  (make-type-list  (rest  sbgl) 

(get  (first  sbgl)  'types)) 
(findtypesfor  (rest  sbgls)  name))))) 

(first  sbgls))))) 


(def  make-type-list  (actuals  type-pattern)  returns  a list  of  var-type  pairs 
(cond  ((nul  actuals)  ()) 

((is-var  (first  actuals)) 

(cons  (cons  (first  actuals) 

(first  type-pattern)) 

(make-type-list  (rest  actuals) 

(rest  type-pattern)))) 

((is-constant  (first  actuals)) 

(make-type-list  (rest  actuals) 

(rest  type-pattern))) 

(t  (append  ;it's  a funapp,  l.c,  a constructed  type,  so 

(hard-type-list  (first  actuals)  ilookup  def  of  type  and  make 
(first  type-pattern))  ;sure  the  constructor 
(make-type-list  (rest  actuals)  ;is  appropriate,  then  find 
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(rest  type-pattern))))))  ;type»  of  the  args 


(def  hard-type-list  (exp  type) 

(cond  ((eq  (vars-in  exp)  ())  ()) 

(t  ((lambda  (bod) 

(cond  (bod  (srch-alts  (list  exp  (gensym))  assumes  inpat  (1  0) 
(rest  bod))) 

(t  (error  '(has  not  yet  been  defined)  type)))) 

(get  type  *body))))) 


(def  srch-alts  (actuals  list-alts) 

(cond  ((null  list-alts)  (error  ’(has  vars  whose  types  I am  unable  to  determine) 
(first  actuals))) 

(t  ((lambda  (sbgls) 

(cond  ((defined  sbgls) 

((lambda  (typedecs) 

(cond  ((null  typedecs) 

(srch-alts  actuals 

(rest  list-alts))) 

(t  ((lambda  (ans) 

(cond  ((all-typed 

(vars-in  (first  actuals)) 
ans) 
ans) 

(t  (srch-alts  actuals 
(rest  list-alts))))) 

(find-var-types 

(vars-in  (first  actuals)) 

(append  (first  sbgls) 
typedecs)))))) 

(find-type-decs  (rest  sbgls)))) 

(t  (srch-alts  actuals  (rest  list-alts))))) 

(half-eval  actuals  (first  list-alts)))))) 


(def  half-eval  (actuals  alt)  ;returns  a substitution  and  list  of  subgoals  with  the 
((lambda  (sub)  substitutions  made 
(cond  ((defined  sub) 

(cons  sub  (mk-subst  (try-pt  alt)  sub))) 

(t  ’undef))) 

(match  actuals  (match-pt  alt)))) 


(def  find-typc-decs  (sbgls) 
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(cond  ((null  sbgls)  ()) 

(t  ((lambda  (sbgl) 

(cond  (Os-type  (first  sbgl)) 

(append  (make-type-Ust  (list  (second  sbgl)) 
(list  (first  sbgl))) 
(find-type-decs  (rest  sbgls)))) 

(t  (find-type-decs  (rest  sbgls))))) 

(first  sbgls))))) 


(def  flnd-var-types  (vars  sub) 

(cond  ((null  vars)  ()) 

(t  (cons  (cons  (first  vars) 

(lookup*  (first  vars)  sub)) 
(find-var-types  (rest  vars)  sub))))) 


(def  all-typed  (vars  alist) 

(cond  ((null  vars)  t) 

((is-type  (lookup  (first  vars)  alist)) 
(all-typed  (rest  vars)  alist)) 


r 


Appendix  Ci  Luting  or  the  lyitn  111 

16.1  Lilting  of  LISP  Implementation 

iprimitive  function  and  type  definitions 
;for  LISP 

(PROC2 

(putprop  'lisp  '( (def  integer  frxpr  (I) 

(cond  ((eq  (length  I)  1) 

(cond  ((fixp  (first  1))  ()) 

(t  ’undef))) 

((ls-constant  (second  I)) 

(cond  ((fixp  (first  I)) 

(cond  ((or  (eq  (second  1)  ’true) 

(eq  (second  I)  t))  () ) 

(t  ’undef))) 

((or  (eq  (second  I)  ’undef) 

(eq  (second  I)  ’false))  ()) 

(t  ’undef))) 

(t  (list  (cons  (second  I) 

(cond  ((fixp  (first  I))  t) 

(t  ’false))))))) 

(def  real  fexpr  (I) 

(cond  ((eq  (length  I)  1) 

(cond  ((floatp  (first  I))  ()) 

(t  ’undef))) 

((is-constant  (second  I)) 

(cond  ((floatp  (first  I)) 

(cond  ((or  (eq  (second  J)  'true) 

(eq  (second  I)  t))  () ) 

(t  ’undef))) 

((or  (eq  (second  I)  ’undef) 

(eq  (second  I)  ’false))  ()) 

(t  ’undef))) 

(t  (list  (cons  (second  I) 

(cond  ((floatp  (first  I))  t) 

(t  ’false))))))) 

(def  boolean  fexpr  (I) 

(cond  ((eq  (length  I)  I) 

(cond  ((or  (eq  (first  I)  t) 

(eq  (first  I)  ’true) 

(eq  (first  I)  ’undef) 

(eq  (first  I)  ’false))  ()) 

(t  ’undef))) 

((is-constant  (second  I)) 

(cond  ((or  (eq  (first  I)  t) 

(eq  (first  I)  ’true) 


I 
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: 

■ 

> 


(eq  (first  I)  ’undef) 

(eq  (first  I)  ’false)) 

(cond  ((or  (eq  (second  I)  ’true) 

(eq  (second  I)  t))  () ) 

(t  ’undef))) 

((or  (eq  (second  I)  ’undef) 

(eq  (second  I)  ’false))  ()) 

(t  ’undef))) 

(t  (list  (cons  (second  I) 

(cond 

((or  (eq  (first  1)  t) 

(eq  (first  I)  ’true) 

(eq  (first  I)  ’undef) 

(eq  (first  I)  ’false))  t) 

(t  ’false))))))) 

(def  s fexpr  (I) 

(cond  ((eq  (length  1)  2) 

(cond  ((or  (o!d<  (first  I)  (second  I)) 

(old-  (first  1)  (second  I)))  ()) 

(t  ’undef))) 

((is-constant  (third  I)) 

(cond  ((or  (old<  (first  1)  (second  I)) 

(old-  (first  I)  (second  I))) 

(cond  ((or  (eq  (third  I)  t) 

(eq  (third  I)  ’true))  ()) 

(t  ’undef))) 

((or  (eq  (third  I)  ’false) 

(eq  (third  I)  ’undef)X)) 

(t  ’undef))) 

(t  (list  (cons  (third  I) 

(cond  ((or  (old<  (first  1)  (second  I)) 
(old-  (first  I)  (second  I))) 
t) 

(t  ’false))))))) 

(def  i fexpr  (1) 

(cond  ((eq  (length  I)  2) 

(cond  ((or  (old>  (first  I)  (second  I)) 

(old-  (first  I)  (second  1)))  ()) 

(t  ’undef))) 

((is-constant  (third  I)) 

(cond  ((or  (old>  (first  I)  (second  I)) 

(old-  (first  I)  (second  I))) 

(cond  ((or  (eq  (third  I)  t) 

(eq  (third  1)  ’true))  0) 

(t  ’undef))) 

((or  (eq  (third  I)  ’false) 


IT? 
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(eq  (third  I)  'undef)X)) 

(t  ’undef))) 

(t  (list  (cons  (third  I) 

(cond  ((or  (old>  (first  1)  (second  I)) 
(old-  (first  I)  (second  I))) 

0 

(t  'false))))))) 

(def  * fexpr  (I) 

(cond  ((eq  (length  I)  2) 

(cond  ((old-  (first  I)  (second  I))  ’undef) 

(t  ()))) 

((is-constant  (third  I)) 

(cond  ((old-  (first  I)  (second  I)) 

(cond  ((or  (eq  (third  I)  ’undef) 

(eq  (third  I)  ’false))  ()) 

(t  ’undef))) 

((or  (eq  (third  I)  ’true) 

(eq  (third  I)  t)X)) 

(f  ’undef))) 

(t  (list  (cons  (third  I) 

(cond  ((old-  (first  I)  (second  I)) 
’false) 

(t  t))))))) 

(putprop  ’old<  (get  ’<  ’subr)  ’subr) 

(putprop  ’old>  (get  ’>  ’subr)  ’subr) 

(putprop  'old-  (get  ’-  ’subr)  ’subr) 

(def  < fexpr  (I) 

(cond  ((eq  (length  1)  2) 

(cond  ((old<  (first  I)  (second  I))  ()) 

(t  ’undef))) 

((is-constant  (third  I)) 

(cond  ((old<  (first  I)  (second  I)) 

(cond  ((or  (eq  (third  I)  ’true) 

(eq  (third  I)  t))  0) 

(t  ’undef))) 

((or  (eq  (third  I)  ’false) 

(eq  (third  I)  ’undef))  0) 

(t  ’undef))) 

(t  (list  (cons  (third  I) 

(cond  ((old<  ( first  I)  (second  I ))  t ) 

(t ’false))))))) 

(def  v fexpr  (I) 

(cond  ((eq  (length  I)  2) 

(cond  ((or  (first  J)  (second  I))  ()) 

(t  ’undef))) 

((is-constant  (third  I)) 
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(cond  ((or  (first  I)  (second  1)) 

(cond  ((or  (eq  (third  I)  ’true) 

(eq  (third  I)  t))  ()) 

(t  ’undef))) 

((or  (eq  (third  I)  ’undef) 

(eq  (third  I)  ’false))  ()) 

(t  ’undef))) 

(t  (list  (cons  (third  I) 

(cond  ((or  (first  1)  (second  I))  t) 

(t  ’false))))))) 

(def  a fexp;  (I) 

(cond  ((eq  (length  I)  2) 

(cond  ((and  (first  I)  (second  0)  ()) 

(t  ’undef))) 

((is-constant  (third  I)) 

(cond  ((and  (first  I)  (second  I)) 

(cond  ((or  (eq  (third  I)  ’true) 

(eq  (third  I)  t))  ()) 

(t  ’undef))) 

((or  (eq  (third  I)  ’undef) 

(eq  (third  I)  ’false))  0) 

(t  ’undef))) 

(t  (list  (cons  (third  I) 

(cond  ((and  (first  I)  (second  I))  t) 

(t  ’false))))))) 

(def  > fexpr  (I) 

(cond  ((eq  (length  1)  2) 

(cond  ((otd>  (first  I)  (second  I))  ()) 

(t  ’undef))) 

((is-constanc  (third  I)) 

(cond  ((old>  (first  I)  (second  1)) 

(cond  ((or  (eq  (third  I)  ’true) 

(eq  (third  I)  t))  ()) 

(t  ’undef))) 

((or  (eq  (third  I)  ’false) 

(eq  (third  I)  ’undef))  ()) 

(t  ’undef))) 

(t  (list  (cons  (third  I) 

(cond  ((o!d>  (first  I)  (second  I))  t) 

(t  ’false))))))) 

(def  • fexpr  (I) 

(cond  ((eq  (length  I)  2) 

(cond  ((old-  (first  1)  (second  I))  0) 

(t  ’undef))) 

((is-constant  (third  I)) 

(cond  ((old-  (first  I)  (second  !)) 
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(cond  ((or  (eq  (third  1)  ’true) 
(eq  (third  1)  l))  ()) 

(t  ’undef))) 

((or  (eq  (third  I)  'false) 

(eq  (third  1)  ’undef))  0) 

(t  ’undef))) 

(t  (list  (cons  (third  I) 

(cond  ((old-  (first  I)  (second  I))  t) 

(t  ’false))))))) 


these  functions  are  already 
defined  properly,  they  are  listed 
here  just  to  indicate  we  didn't 
forget  them 


(def  + (x  y)  (+  x y)) 
(def  - (x  y)  (-  x y)) 
(def  * (x  y)  (*  x y)) 
(def  II  (x  y)  (//  x y)) 
(def  r+  (x  y)  (+$  x y)) 
(def  r-  (x  y)  (-S  x y)) 
(def  r*  (x  y)  (*S  x y)) 
(def  rll  (x  y)  ( IIS  x y)) 


-.stuff  for  adding  strings  which  are  represented  as  a list  of  2 elements, 

; the  first  Is  the  atom  STRING,  the  second  is  a list  of  the  characters  in  the 
; string. 

(def  readstring  () 

(prog  (temp  hdr) 

(setq  temp  (cons  (readch)  () )) 

(setq  hdr  (cons  temp  temp)) 

(return  (do  ((nxtehar  (readch)  (readch))) 

((and  (eq  nxtehar ’“) 

(not  (eq  (tyipeek.)  42))) 

(list  'string  (car  hdr))) 

(cond  ((eq  nxtehar  "'Xreadch))) 

(setq  temp  (cons  nxtehar  () )) 

(rplacd  (edr  hdr)  temp) 

(rplacd  hdr  temp))))) 

(def  string  fexpr  (I)  (cons  'string  I)) 

(setsyntax  'macro  ’readstring) 

(putprop  'prt  (get  'print  'subr)  ’subr) 

(def  print  (x) 

(cond  ((or  (atom  x)  (not  (eq  (first  x)  ’string))) 

(prt  x)) 

(t  (prt  (maknam  (second  x)))))) 

(def  is-string  fexpr  (x) 

(cond  ((eq  (length  x)  I) 

((lambda  (y) 
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(cond 

((and  (not  (atom  y)) 

(eq  (first  y)  Wine) 

(null  (rest  (rest  y))))  ()) 

(t  ’undef))) 

(eval  (first  x)))) 

(t  ((lambda  (yl  y2) 

(cond 

((and  (not  (atom  yl)) 

(eq  (first  yl)  ’string) 

(null  (rest  (rest  yl)))) 

(cond  ((or  (eq  y2  ‘true) 

(eq  y2  t))  ()) 

((or  (eq  y2  ’false) 

(eq  y2  ’undef))  ’undef) 

(t  (list  (cons  y2  t))))) 

((or  (eq  y2  ’false) 

(eq  y2  ’undef))  ()) 

((or  (eq  y2  ’true) 

(eq  y2  t))  ’undef) 

(t  (list  (cons  y2  ’false))))) 

(eval  (first  x)) 

(second  x))))) 

(def  s-cat  (x  y) 

(cond  ((not  (is-string  x)) 

(error  '(s-cat  applied  to  non-string)  x)) 

((not  (is-string  y)) 

(error  ’(s-cat  applied  to  non-string)  y)) 

(t  (list  'string  (append  (second  x)  (second  y)))))) 

(def  firstch  (x) 

(cond  ((not  (is-string  x))  (error  '(firstch  of  non-string)x)) 

((atom  (second  x))  (error  ’(firstch  of  emptystring)x)) 

(t  (first  (second  x))))) 

(def  tail  (x) 

(cond  ((not  (is-string  x))  (error  ’(tail  of  non-string)  x)) 

((atom  (second  x))  (error  '(tail  of  emptystring)x)) 

(t  (list  'string  (rest  (second  x)))))) 

(def  s-cons  (x  y) 

(cond  ((not  (eq  (flatc  x)  I))  (error  ’(bad  character  object/,  s-cons)  x)) 

((not  (Is-strine  y))  (error  ’(s-cons  of  non-string)  y)) 

(t  (list  'string  (cons  x (second  y)))))) 

(def  mk-string  (x)  (cond  ((not  (eq  (ftatc  x)  I))  (error  '(mk-string  of  non-character) 

x)) 

(t  (list  'string  (cons  x () ))))) 

(def  is- list  (I) 

(cond  ((atom  I)  (eq  I nit)) 
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(t  (is-list  (rest  I))))) 

(def  firstsym  fexpr  (I)  (matchterms  (second  1)  (list  'quote  (ratom)))) 
(def  firstexp  fexpr  (I)  (matchterms  (second  I)  (read))) 


(def  write  (x)  (print  x)  ()) 


) 

’prlmdefs) 

NIL)  ;end  of  prog  surrounding  ail  the  primitive  definitions 

;the  following  include  all  definitions  needed  for  lisp  to  run  generated  programs 


(def  bktrkcond  (actuals  list-alts) 

(cond  ((null  list-alts)  ’undef) 

(t  ((lambda  (alt) 

((lambda  (answer-sub) 

(cond  ((defined  answer-sub) 

(cleanup  answer-sub  actuals)) 

(t  (bktrkcond  actuals  (rest  list-alts))))) 
((lambda  (sub) 

(cond  ((defined  sub) 

(append-if-defined  sub 

(try  (mk-sgbst  (try-pt  alt) 
tub)))) 

(t  ’undef))) 

(match  actuals  (match-pt  alt))))) 

(new-version  (first  list-alts)))))) 


(def  new-version  (alt) 

((lambda  (sub) 

(list  (mk-subst  (match-pt  alt)  sub) 

((lambda  (newtry) 

(cons  ’try  (mk-subst  newtry  (chg-formals  newtry)))) 
(mk-subst  (try-pt  alt)  sub)))) 

(chg-in  (match-pt  alt)))) 


i 

3 


■t 

3 


(def  chg-formals  (sbgoals) 
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I 

i 

I 

* 

I 


(cond  ((null  sbgoals)  0) 

(t  ((lambda  (x)  (cond  (x  (append  x (chg-formals  (mk-subst 

(rest  sbgoals) 

%)))) 

(t  (chg-formals  (rest  sbgoals))))) 

(chg-in  (rest  (first  sbgoals))))))) 

(def  chg-in  (params) 

(cond  ((null  params)  ()) 

((atom  (first  params)) 

(cond 

((eq  (flrstchar  (first  params))  1) 

((lambda  (chg)  (cons  chg  (chg-in  (subst  (cdr  chg) 

(car  chg) 

(rest  params))))) 

(cons  (first  params)  (gensym)))) 

(t  (chg-in  (rest  params))))) 

((eq  (first  (first  params))  ’quote) 

(chg-in  (rest  params))) 

(t  ((lambda  (chgs) 

(append  chgs  (chg-in  (mk-subst  (rest  params)  chgs)))) 
(chg-in  (rest  (first  params))))))) 


(def  flrstchar  (name) 

(first  (explode  name))) 


(def  cleanup  (sub  actuals)  (reverse  (cleanup*  sub  actuals  () ))) 

(def  cleanup*  (sub  actuals  ans) 

(cond  ((null  actuals)  ans) 

(t  ((lambda  (act) 

(cond  ((is-var  act) 

(cond  ((already-there  act  ans) 

(cleanup*  sub  (rest  actuals)  ans)) 
(t  (cleanup*  sub  (rest  actuals) 

(cons  (cons  act 

(lookup*  act  sub)) 
ans))))) 

((is-constant  act) 

(cleanup*  sub  (rest  actuals)  ans)) 

(t  (cleanup*  sub  (rest  actuals) 

(cleanup*  sub  (rest  act)  ans))))) 

(first  actuals))))) 


(def  already-there  (name  alist) 


Mhmi 
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(cond  ((null  allst)  nil) 

((eq  name  (var  (first  allst)))  t) 

(t  (already-there  name  (rest  alist))))) 

(def  lookup*  (exp  alist)  ;makes  all  substitutions  in  alist  that  are 

(do  ((value  (mk-subst  exp  alist)  nxtval)  applicable  to  exp 

(nxtval  (mk-subst  (mk-subst  exp  alist)  alist) 

(mk-subst  nxtval  alist)) ) 

((equal  value  nxtval)  value))) 


(def  try  (subgoals) 

(cond  ((null  subgoals)  () ) 

<t 

( (lambda  (sub) 

(cond  ((defined  sub) 

(append-if-defined  sub 

(try  (mk-subst 

(rest  subgoals) 
sub)))) 

(t  ’undef))) 

(eval  (first  subgoals)) )) 

)) 


(def  append-if-defined  (sub  I sub2)  ;when  used  in  conjunction 

(cond  ((and  (defined  subl)  (defined  sub 2))  ;with  "try*,  this  Involves 

(append  subl  sub2))  ; a redundant  test  on  the 

(t  ’undef)))  ;first  argument  (who  cares?) 

(def  true-precond  (fnapp) 

(prog  (env2  ans-sub) 

(setq  env2  (bind  (matchlis  (first  fnapp))  (rest  fnapp))) 

(setq  ans-sub  (evpred  (mk-subst  (get  (first  fnapp)  ’precond)  env2))) 
(return  (cond  ((eq  ans-sub  ())  t) 

((eq  ans-sub  ’undef)  nil) 

(t  (error  ’(variables  in  precond  check)  ans-sub)))))) 


precondition  checker  - evpred  evaluates  wffs 
(def  evpred  (0 

(cond  ((atom  f)  (cond  ((eq  f t)  ()) 

((eq  f nil)  (error  '(no  precondition  exists  for) 
(first  fnapp))) 

(t  (error  ’(weird  atomic  predicate^))) 

((is-or  f)  (evor  (rest  f))) 


((is-and  f)  (evand  (rest  f))) 
.otherwise  it  is  a pred-app 
(t  (eval  f)))) 
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(def  is-or  (f)  (eq  (first  f)  V» 


(def  evor  (I)  (prog  (val) 

(setq  val  (evpred  (first  I))) 

(return  (cond  ((eq  undef  val)  (evpred  (second  I))) 

((eq  0 val)  0) 

(t  (evpred  (second  I)))  ;who  knows,  we  might  as  well  let  'em  try 
(t  (error  '(evpred  evaluates  to  something  other  than  0 or  undef) 
(cons  val  (first  I)))))))) 

(def  is-and  (f)  (eq  (first  f)  ’a)) 


(def  evand  (I)  (prog  (val) 

(setq  val  (evpred  (first  I))) 

(return  (cond  ((eq  val  ())  (evpred  (second  I))) 

((eq  val  ’undef)  'undef) 

(t  (error  ’(evpred  evaluates  to  weirdness)  (cons  val  (first  I)) 

)))))) 


(def  defined  (x)  (not  (eq  x ’undef))) 

;bind  is  here  creating  an  alist,  (a  list  of  “(var. value)"  pairs) 

(def  bind  (II  12) 

(cond  ((null  II)  ()) 

(t  (cons  (cons  (first  II)  (first  12))  (bind  (rest  II)  (rest  12)))))) 
(def  matchlis  (fname)  (get  fname  ’params)) 


(def  match  (It  12) 

(prog  (termatch) 

(return  (cond  ((null  II)  (cond  ((null  12)  ()) 

(t  (error  ’(tried  to  match  lists  of  unequal  Iength)l2 

)))) 

(t  (setq  termatch  (matchterms  (first  II)  (first  12))) 

(prog  (restmatch) 

(return 

(cond  ((null  termatch)  (match  (rest  II)  (rest  12))) 
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((eq  termatch  ’undef)  ’undef) 

((defined 

(setq  restmacch 

(match  (mk-subst  (rest  II)  termatch) 

(mk-subst  (rest  12)  termatch)))) 

(append  termatch  restmatch)) 

(t  ’undef)))) ))))) 

(def  mk-subst  (termlist  alist)  factually,  termlist  can  be 

(cond  ((and  (atom  termlist) 

(or  (numberp  termlist) 

(eq  termlist  t) 

(eq  termlist  ’f) 

(eq  termlist  ’true) 

(eq  termlist  ’undef) 

(eq  termlist  ’false) 

(eq  termlist  nil))) 

termlist) 

((and  (not  (atom  termlist)) 

(or  (not  (is-string  termlist))  (eq  (first  termlist)  ’quote))) 
termlist) 

(t 

(do  ((I  alist  (rest  I)) 

(exp  termlist  (subst  (val  (first  1))  (var  (first  I))  exp))) 

((null  I)  exp))))) 

(def  val  (x)  (edr  x)) 

(def  var  (x)  (car  x)) 

;all  variables  occurring  in  the  terms  to  be  matched  are  unbound,  as  substitutions 
;are  made  as  we  go 

(def  matchterms  (tl  t2) 

(prog  (f) 

(return  (cond  ((equal  tl  t2)  0) 

((atom  tl)  (cond  ((is-var  tl)  (cond  ((or  (eq(is-string  t2X)) 

(atom  t2))  (cons 

(cons  tl  t2) 

())) 

((occurs-in  tl  t2) 

(cond  ((get 
(setq  f 

(implode  (append 
(explode 
’equal-bind-) 

(explode 
(get  (first  t2) 
fypename))))) 

*bod  ‘ 


1 
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(f  tl  t2)) 

(t  ’undef))) 

(t  (corn  (cons  tl  t2)  ())))) 

(t  (cond  ((is-var  t2)  (cons  (cons  t2  tl)  ())) 

((ls-constant  tl) 

(cond  ((atom  t2)  ’undef) 

((and  (eq  (first  t2)  ’quote) 

(eq  (second  t2)  tl)) 

0) 

(t  ’undef))) 

((is-constant  t2)  ’undef) 

((concains-var  t2)  (cond 
((get 
(setq  f 

(implode  (append 
(explode 
’equal-bind-) 

(explode 
(get  (first  t2) 

’typename))))) 

’body) 

<f  tl  t2)) 

(t  ’undef))) 

((get 

(setq  f (implode  (append 
(explode 
’equal-) 

(explode 
(get  (first  t2) 
typename))))) 

’body) 

(cond  ((f  tl  t2)  0) 

(t  ’undef))) 

(t  ’undef))))) 

((is-var  t2)  (cond 

((eq  (is-string  tl)  ()) 

(cons  (cons  t2  tl)  () )) 

((occurs-in  t2  tl) 

(cond  ((get 
(setq  f 

(implode  (append 
(explode 
’equal-bind-) 

(explode 

i (get  (first  tl) 

I 
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'typename))))) 

’body) 

(ft 1 12)) 

(t  ’undef))) 

(t  (con*  (con*  t2  tl)  ())))) 

((and  (atom  t2)  (l*-constant  t2)) 

(cond  ((and  (eq  (first  tl;  ’quote) 

(eq  (second  tl)  t2)) 

0) 

(t  ’undef))) 

((get  (setq  f (implode  (append  (explode  ’equal-) 

(explode  (get  (first  tl) 

’typename))))) 

'body) 

(cond  <(f  tl  t2)  0) 

(t  ’undef))) 

((or  (and  (not  (eq  (is-string  tl)  ())Xcontains-var  tl)) 

(and  (not  (eq  (is-string  t2)  ())Xcontains-var  t2))) 

(cond  ((get  (setq  f (implode  (append 

(explode 
’equal-bind-) 

(explode 
(get  ( first  tl) 

’typename))))) 

’body) 

(ftl  12)) 

((and  (eq  (first  tl)  (first  t2))  (not  (eq  (first  tl)  'quote))) 
(match  (rest  tl)  (rest  t2))) 

((eq  (first  tl)  ’list) 

(matchterms  (cons-out  (rest  tl))  t2)) 

((eq  (first  t2)  ’list) 

(matchterms  (cons-out  (rest  t2))  tl)) 

((eq  (first  tl)  ’cons) 

(cond  ((eq  (first  t2)  ’quote) 

((lambda  (x) 

(cond 

((defined  x) 

((lambda  (y) 

(cond 

((defined  y) 

(append  x y)) 

(t  ’undef))) 

(matchterms 

_ (mk-subst  (third  tl)  x) 

(list  'quote 

(rest  (second  t2)) )))) 
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(t  ’undef))) 

(matchterms  (second  tl) 

(list  'quote 

(first  (second  t2)))))) 


(t 

((lambda  (x) 

(cond 

((defined  x) 

((lambda  (y) 

(cond 

((defined  y) 

(append  x y)) 

(t  ’undef))) 

(matchterms 

(mk-subst  (third  tl)  x) 
(mk-subst  (rest  t2)  x)))) 

(t  'undef))) 

(matchterms  (second  tl)  (first  t2)))))) 
«eq  (first  t2)  ’cons) 

(cond  ((eq  (first  tl)  ’quote) 

((lambda  (x) 

(cond 

((defined  x) 

((lambda  (y) 

(cond 


((defined  y) 

(append  x y)) 

(t  ’undef))) 

(matchterms 

(mk-subst  (third  t2)  x) 
(list  'quote 

(rest  (second  tl)) )))) 


(t  ’undef))) 

(matchterms  (second  t2) 

(list  ’quote 

(first  (second  tl)))))) 
(t 

((lambda  (x) 

(cond 

((defined  x) 


((lambda  (y) 

(cond 

((defined  y) 
(append  x y)) 


(t  ’undef))) 
(matchterms 


(def  contains-var  (exp) 

(cond  ((atom  exp)  (is-var  exp)) 

(t  (list-contaln*-var  (rest  exp))))) 

;contains-var  ignores  function  names  when  looking  for  variables  since  the  only 
functions  left  in  at  this  point  are  constant  functions  (arithmetic  and  constructors) 
(def  list-contains-var  (explist) 

(cond  ((null  explist)  nil) 

((contains-var  (first  explist))  t) 

(t  (list-contains-var  (rest  explist))))) 

(def  occurs-in  (var  exp) 

(cond  ((atom  exp)  (cond  ((eq  var  exp)  t) 

(t  nil))) 

((occurs-in  var  (first  exp))  t) 

(t  (occurs-in  var  (rest  exp))))) 

(def  match-pt  (alternative)  (first  alternative)) 

(def  try-pt  (alternative)  (rest  (second  alternative))) 


;***  automatic  predicating  *** 

• (def  autopred  (f  varlist) 

(cond 

((get  f ’body)  nil)  tit’s  already  defined,  go  away 
(putprop  f (mk-params  varlist)  ’params) 

(putprop  f t ’precond)  ;using  system  defined  functions  relys  on  the 
(putprop  f (invent-pat  varlist)  'inpat) 

(putprop  f t ’postcond) 

(putprop  f (mk-predbody  f varlist)  ’body)))) 

(def  mk-params  (varlist) 

(do  ((ct  varlist  (rest  ct)) 

(I  ()  (cons  (intern  (gensym))  1))) 

((null  ct)  I))) 

(def  mk-predbody  (f  varlist) 


Mmmmm 
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(prog  (namestring) 

(setq  namestring  (explode  0) 

(return  (cond  ((eq  (second  namestring)  'f) 

(eval  (list  ’defun  f 'fexpr  ’(argl) 

(list  ’prog  ’(sepllst  outpos) 

’(setq  seplist  (split  argl)) 

’(setq  outpos  (second  seplist)) 

(list  ’return 
(list  'cond 

(list  '(is-var  outpos) 

(list  ’list 
(list  'cons 
'outpos 
(list  ’eval 
(list  ’cons 

(list  'quote 
(cond 

((eq  (third  namestring)  ’//) 

(implode  (rest  (rest  (rest  namestring))))) 

(t 

(implode 
(rest  (rest 

namestrinj) 

))) ) 

‘(first  seplist))) ))) 

(list  (list 

'equal 
’outpos 
(list  'eval 
(list  'cons 
(list  'quote 
(cond 


((eq  (third  namestring)  'll) 

(Implode  (rest  (rest  (rest  namestring))))) 

(t 

(implode 
(rest  (rest 

namestring)) 

)))) 

’(first  seplist))) ) 

0) 

(list  t ’’undef) )))))) 

((eq  (second  namestring)  ’p) 

(eval  (list  ’defun  f 'fexpr  '(argl) 

(list  'prog  ’(seplist  ans) 

’(setq  seplist  (split  argl)) 


I 


i 

i 
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(list  'setq 
‘am 

(list  'evat 
(list  ’cons 
(list  'quote 
(implode 
(rest  (rest 

namestring)) 

)) 

'(first  seplist)))) 

’(return 

(cond 

((is-var  (second  seplist)) 
(list  (cons  (second  seplist) 
ans))) 

((equal  ans  (second  seplist)) 

0) 

(t  ’undef))) 

)))) 

(t  (error  ’(autopred  called  w/no  2p  or  IX)  f)))))) 

(def  split  (I)  (cond  ((null  I)  (error  '(request  to  split  empty  list)!)) 

((null  (rest  I))  (list  ()  (first  I))) 

(t  ((lambda  (h)  (cons  (cons  (first  1)  (first  h)) 

(rest  h))) 

(split  (rest  I)))))) 

(def  invent-pat  (varlist) 

(do  ((ct  (rest  varlist)  (rest  ct)) 

(pat  (cons  0 0 ) (cons  1 pat))) 

((null  ct)  pat))) 


16.2  Listing  of  Pascal  Implementation 
;lisp  programs  for  generating  pascal 

;each  function  specification  gets  turned  into  a complete  program  so  that 
;a  library  of  functions  can  be  built.  Each  function  is  declared  external. 
;the  surrounding  program  is  Just  a dummy  to  satisfy  syntax  restrictions. 

;a  type  specification  is  turned  into  a type  declaration  and  stuffed  on  the 
property  list  of  the  type  name(under  ’type-dec),  to  be 
included  in  the  declaration  of  every 

function  that  uses  the  type,  (apparently  there  is  no  such  thing  as  an 
external  type  in  pascal,  so  it  has  to  be  re-declared  everywhere) 
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(def  make.pascaLdef  () 

(append 

(list  'program  7 (gensym)  7,  name  7;  7 


) 


(make-type-decs)  ;makes  the  definitions  for  all  types  used 
;i.e.,  termlists,  terms,  constants,  symbols, 

; and  whatever  else  is  necessary  as  subtypes 
(make-external-decs  (get  name  ’external-procs)) 

(list  'function  7 name  (rest  (make-parameter-list 

(strip!  (get  name  'params)) 
(get  name  'inpat))) 

'boolean  7;  7 


)) 


(make-body-of  name);dont  forget  to  include:  new(actuals); 
(list  'begin  7 ; actualsT.sl true; 

'end  7.) 


(def  atrip!  (varlist) 

(cond  ((null  varlist)  ()) 

(t  (cons  ((lambda  (namelist) 

(cond  ((eq  (first  namelist)  *!) 

(implode  (rest  namelist))) 
(t  (first  varlist)))) 

(explode  (first  varlist))) 

(strip!  (rest  varlist)))))) 


(def  make-parameter-list  (params  inpat)  declares  all  formats  to  be  type  term,  but 
(cond  ((null  paramsX))  ;leaves  an  extra  on  the 

(t  (append  ; front  of  the  list 

((lambda  (arg) 

((lambda  (first-dec) 

(cond  ((eq  (first  inpat)  0) 

(append  ’(/;  var)  first-dec)) 

(t  (cons  7;  first-dec)))) 

(list  arg  ’term))) 

(first  params)) 

(make-parameter-list  (rest  params)  (rest  inpat)))))) 


;every  formal  parameter  is  of  type  TERM 
;every  local  used  by  the  spec  must  be  of  type  TERM 
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(def  make-local-decs  (locals)  ;takes  a 4 element  list  of  vars  to  be  declared  u 
(append  '(var  / 

;termlists,  terms,  constants,  and 
) symbols,  and  returns  a list  that 

(cons  V (rest  consists  of  the  pascal  to  do  it 

(rest  (make-decs  (first  locals) 

’termlist)))) 

(cons  7 (rest 

(rest  (make-decs  (second  locals) 

'term)))) 

(cond  ((null  (third  locals))  ())  (t 
(cons  V (rest 

(rest  (make-decs  (third  locals) 

'constant)))))) 

(cond  ((null  (fourth  locals))  ())  (t 
(cons  7 (rest 

(rest  (make-decs  (fourth  locals) 

’symbol)))))))) 

(def  make-decs  (vars  type)  ;makes  a list  of  vars  : type,  leaves  an  extra  V 
(cond  ((null  vars)  (list 7 type’/;’/ 

))  ;and  " " on  from 

(t  (append  (list  7, 7 (first  vars)) 

(make-decs  (rest  vars)  type))))) 

(def  make-type-decs  () 

’(type  / 

/ alltyps  / - / /( integertyp  /.  realtyp  /,  booleantyp  /. 

chartyp  /,  symboltyp  /)  /;  / 

/ 

/ termtyps  / -/  /(  variable  /,  / constanttyp  /,  / funapp  /)/;/ 

/ term  / ■/  ttl  /;/ 

/ 

/ termlist/  >/  Ttll/y 

/ 

/ constant/  -/  td/7 

/ 

/ symbol/  >/  Tsyml/; 

/ 

/ 1 1/  •/  record/ 

/ / case  / ttyp:termtyps  / of/ 

III  variable:/  /(vr:/  integer/)/;/ 

III  constanttyp:/  /(enst^  constant/)/;/ 

III  funapp 7 /(fname:/  symbol/;/ 

I I I I I arg s7  termlist/)/ 


I 
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/ / end  IJ 

/ 

/ til / ■/  record/ 

I I notempty :/  boolean// 

/ / first:/  term// 

I I rest:/  termlist/ 

/ / end// 

/ 

/ cl/ -/record/ 

/ / case/  ctyp:alltyps/  of/ 

/ / / integertyp:/  /(ival:/  integer/)// 

/ / / realtyp:/  /(rval:/  real/)// 

/ / / booleantyp:/  /(bval/  boolean/)// 

/ / / chartyp:/  /(eval/  char/)// 

/ / / symboltyp:/  /(sval:/  symbol/)/ 

/ / end// 

/ 

/ syml/  -/  record/ 

/ / notempty/  boolean// 

/ / flrstch/  char// 

/ / tail:/  symbol  IJ 

I I end// 

/ 

/ varpalrs/  -/  Tvp// 

I 

I vp / -/  record/ 

/ / notempty:/  boolean  IJ 

I I old:/  integer// 

/ / new/  integer// 

/ / rest:/  varpalrs/ 

/ / end// 

/ 

)) 


(def  cons-if-new  (x  I) 

(cond  ((memq  x I)  I) 
(t  (cons  x I)))) 


(def  general-funs  () 

'(function  / occur (x//  y:/  term):/  boolean// 

/ extern// 

function/  genvar/  integer// 

/ extern// 

procedure  / replaced//  t:/  term//  var/  tml/  termlist)// 
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/ extern Ij 

procedure/  subst (x//  t :/  term  IJ  var  / 1 1/./ 12:/  termlist)// 

I extern// 

function/  eq sym(x//  y 7 symbol):/  boolean/;/ 

/ extern/;/ 

function/  eqconst(x//  y:/  constant):/  boolean Ij 
I extern// 

function/  cop  ysy  m(oldsym/  symbol):/  symbol/;/ 

/ extern/;/ 

function/  copyterm(oldtm:/  term):/  term/;/ 

/ extern/;/ 

function/  copytermlist(tml:/  termlist):/  termlist IJ 
I extern// 

function/  copyconst(o1dconst:/  constant)/  constant Ij 
I extern// 

function/  unify(var/  x/,y/.allx/1ally:termlist/;failed:boolean)/  boolean// 
/ extern// 

procedure/  Lookup(tm:/  term//  tbl:/  varpairs//  found/  boolean)// 

/ extern// 

procedure/  Standapart(tml:/  termlist//  var/  donetbl/  varpairs)// 

/ extern// 

)) 


(def  make-external-decs  (procnames) 

(cond  ((null  procnames)  (general-funs)) 

(t  (append  (mk-ext-dec  (first  procnames)) 

(make-external-decs  (rest  procnames)))))) 


(def  mk-ext-dec  (name) 

((lambda  (x) 

(cond  (x  x) 

(t  (putprop  name  (list  ’FUNCTION  7 name 

(make-parameter-list  (get  name  ’types) 
(get  name  'inpat)) 

’:  7 ’boolean  7;  7 

7 'EXTERN  7;  7 

) 

’extproc-head)))) 

(get  name  ’extproc-head))) 


(def  algol-Ue  (wff) 

(cond  ((atom  wff)  ’true) 
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((eq  (first  wff)  ’a) 

((lambda  (are I arg2) 

(cond  »eq  argl  ’true)  (cond  ((eq  arg2  ’true)  TRUE) 

(t  arg2))) 

((eq  arg2  ’true)  argl) 

(t  (list  argl  ‘AND  arg2)))) 

(algol-ize  (second  wff)) 

(algol-ize  (third  wff)))) 

((eq  (first  wff)  ’v) 

((lambda  (argl  arg2) 

(cond  ((eq  argl  ’true)  TRUE) 

((eq  arg2  ’true)  TRUE) 

(t  (list  argl  'OR  arg2)))) 

(algol-ize  (second  wff)) 

(algol-ize  (third  wff)))) 

(t  ((lambda  (ans-code)  ;o.w.  it  is  a funapp,  so  generate 
(setq  pascode  (append  pascode  ;pascal  to  represent  the 
(rest  ans-code)))  ;terms  and  build  the 
(list  (first  wff)  ;new  call 

(first  ans-code))) 

(actualize  (rest  wff)))))) 


(def  make-try  (trylist)  ;gets  called  with  the  list  of  subgoals  with 

(cond  ((null  trylist)  ’true)  ;the  ’‘try"  stripped  off,  and  generates  a 
(t  ((lambda  (call)  ;con junction  out  of  the  subgoal  calls 

(cond  ((null  (rest  trylist)) 
call) 

(t  (append  call 
’(AND) 

(make-try  (rest  trylist)))))) 

(list  (first  (first  trylist)) 

(rest  (first  trylist))))))) 


(def  stripdeep!  (exp) 

(cond  ((atom  exp)  ((lambda  (namelist) 

(cond  ((eq  (first  namelist)  1) 
(implode  (rest  namelist))) 
(t  exp))) 

(explode  exp))) 

(t  (cons  (stripdeep!  (first  exp)) 

(stripdeep!  (rest  exp)))))) 


I 

I 

T 


| 

* 


f ’ 

ft  A 
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(def  make-bod  y-of  (name) 

(prog  (donelist  local-vars  pascode) 

(jetq  local-vars  '((actuals  copyactuals  matchlist)  0 0 0)) 
(setq  donelist  (strip!  (get  name  'params))) 

(setq  pascode 
(append 
'(BEGIN  / 


) 


))) 


pascode 

'(if/ 

(list  (algol-iie  (stripdeep!  (get  name  ’typedprecond)))  7 
'(then  / begin  / 

(build-actuals  (strip!  (get  name  ’params))) 

(do  ((alts  (reverse  (stripdeep!  (rest  (get  name  'body))))  (rest  alts)) 
(ans  ()  ((lambda  (alt) 

(setq  donelist  '(actuals  copyactuals  matchlist)) 
(append 

'(copyactuals  / > / copytermlist  (actuals)  /;  / 
new(donetbl)/;/ 

donetblT/.notempty/  :•/  false/;/ 
standapart  (copyactuals/,  donetbl)/;/ 

(mk-termlist  'matchlist  (match-pt  alt)) 

'(if  / unify  (copyactuals  /,  matchlist/,  copyactuals/, 
matchlist/,  failed)  / 
then  / begin  / 

((lambda  (sbgls-code) 

(append  (rest  sbgls-code) 

(list  'failed  7 7 'not  7 

(make-try  (first  sbgls-code))  7 
'end  7 

(fix-subgoals  (try-pt  alt))) 

’(else  / failed  / :■  / true  /;  / 

ans)) 

(first  alts)))) 

((null  alts)  ans)) 

(list  'nag  7 7 'not  7 'failed  7;  7 

name  7 V/  'nag'/;’/ 

'If'/  'nag'/ 

'then  7 'begin  7 


Appendix  Ci  LUUnf  of  the  •yilex  1 79 


r 


I 


I 


1 


( 

! 


» 


(mk-attgnt  (strip!  (get  name  ’paramt))) 
(list  ’end  7 
’end  7 

’else’/  name  7’>  7 ’false  7 
’end 

))) 

(return 

(append 

(make-tocal-decs  local-vars) 

’(/  donetbl:/  varpair slJ 
I flag IJ  failed:/  boolean IJ 

I 

) pascode)))) 


(def  mk-augns  (paramt) 

(cond  ((null  paramt)  ()) 

(t  (append  (litt  (first  paramt)  7 ’copyactualtT/.firtl  7;  7 
’copyactuals  7 ’copyactualtT/.rett  7;  7 
) (mk-attgnt  (rest  paramt)))))) 


;build-actualt  generatet  the  patcal  code  to  build  a termlitt  out  of  the  actual 
.parameter^  the  actualt  are  already  of  type  term,  to  all  it  hat  to  do  it  link 
;them  together  into  a termlitt  called  actualt  to  they  will  be  appropriate  input 
;to  the  unifier. 

(def  build-actualt  (paramt) 

(append 

(litt  ’new  ’(actualt)  7;  7 

’actualtT/.notempty  7 7 ’falte  7;  7 

(do  ((vars  paramt  (rest  vart)) 

(ant  ()  ((lambda  (temp) 

(addlocal-tml  temp) 

(append 

(litt  ’new  ’/( temp  7)  7;  7 

temp  ’T’/.’notempty  ’/  7 ’true’/;  7 

temp  *t  ’/.’firtt  7 7 (first  vart)  ’/;’/ 

temp  r/.'rest  7 7 ’actualt’/;  7 

’actualt  7 7 temp  7;  7 

ant)) 

(gentym)))) 

((null  vart)  ant)))) 


MMko 
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(def  mk-termlist  (name  arglist)  -.generates  the  pascal  code  to  make  a termlist, 
(addlocal-tml  name)  ;pointed  to  by  name,  whose  elements  are  made  up 
;of  terms  constructed  from  the  elements  of  argUst. 
idonelist  is  global  (local  to  make-body)  and  is 
;re-initialued  whenever  a new  alternative  is 
ibeing  translated.  All  variables  created  in  this 
process  (new'd)  must  be  added  to  the  list  kxal- 
;vars  so  that  the  appropriate  declarations  will  be 
generated  for  them. 

(append 

(list  ’new  ’/(  name  7)  7;  7 

name ’t  7.  ’notempty  7 ’:-’/  ’false  7;  7 


) 


)) 


(do  ((args  (reverse  arglist)  (rest  args)) 

(ans  ()  ((lambda  (temp) 

(addlocal-tml  temp) 

(append 

(list  ’new  ’/( temp  7)  7;  7 

temp  'f  ’/.  'notempty  7 *true  '/;7 

(cond  ((is-var  (first  args)) 

(cond  ((memq  (first  args)  donelist) 
(list  temp  T/.'first’/ 

(first  args)’/;’/ 


))))) 


))) 


(t  (mark-done  (first  args)) 

(append  (mk-term  (first  args) 
(first  args)) 

(list  temp  T/.’first  7 ':-’/ 
(first  args)  7;  7 

(t  ((lambda  (tmname) 

(append  (mk-term  tmname  (first  args)) 
(list  temp’f/.’first  7 ’;-’/ 
tmname  7;  7 

(gensym)))) 

(list  temp’f’/.’rest  7 7 name  7;  7 

name  7 ’:-'/  temp  7;  7 


ans)) 

(gensym)))) 
((null  args)  ans)))) 
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(def  mk-term  (name  arg) 

(prog  (quotflag) 

(addlocal-tm  name) 

(return 

(append 

(list  ’new  '/(  name  7)  7i  7 

) 

(cond  ((is-var  arg) 

(list  name’T'/.'ttyp  7 7 ‘variable’/:  7 

name  ’t’/.’vr  7 7 ’genvar  7;  7 

((ls-constant  arg) 

(cond  ((is-quoted  arg)  (setq  quotflag  t) 

(setq  arg  (second  arg)))) 

(cond  ((atom  arg) 

(append  (list  name  T/.’ttyp  7 ’constanttyp’/;  7 
((lambda  (con) 

(append 

(mk -const  con  arg) 

(list  name  T/.’cnst  7 con’/;’/ 

(gensym)))) 

(quotflag 

(append  (list  name't'/.’ttyp  7 ’:■'/  'funapp'/;  7 
(mk-sym  'cons  (explode  ’cons)) 

((lambda  (tml) 

(append 

(mk-termlist  tml  (rest  (cons-out  arg))) 
(list  name’t’/.'fname’/  ’:•’/  ’cons  7:7 
name’T’/.'args  7 tml’/:  7 

(gensym)))) 

(t  (append 

(list  name'T’/.’ttyp  7 ':■’/  'funapp'/:  7 
(mk-sym  (first  arg)  (explode  (first  arg))) 
((lambda  (tml) 

(mk-termlist  tml  (rest  arg))) 

(gensym)) 

(list  name’t’/.'fname'/  ’:•’/  (first  arg)’/:’/ 
name't’/.’args  7 ':■'/  tml’/:  7 

(t  (append 

(list  name’T’/.’ttyp  7 ’:•’/  'funapp'/:  7 
) (mk-sym  (first  arg)  (explode  (first  arg))) 

((lambda  (tml) 

(mk-termlist  tml  (rest  arg))) 


) 

))) 

) 

))) 

) 

))))) 
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(gensym)) 

(list  name’t’/.’fname'/  (first  arg)’/;’/ 
name’t’/.’args  7 ’:•’/  tmf/;  7 

)))))))) 


(def  cons-out  (list) 

(cond  ((null  list)  ()) 

(t  (list  'cons  (cond  ((is-constant  (first  list))  (first  list)) 
(t  (list  'quote  (first  list)))) 

(cons-out  (rest  list)))))) 


(def  mk -const  (name  atm) 

(addkscal-cnst  name) 

(append  (list  'new  '/(  name  7)  7;7 

(cond  ((fixp  atm)  (list  name’t’/.’ctyp  7 7 ’integertyp’/;  7 

name’t’/.’ival  7 7 atm  7;  7 

» 

((floatp  atm)  (list  name’t'/.’ctyp  7 ’:•’/  ’real’/;  7 
name'T'/.'rval  7 ’>7  atm  7;  7 

)) 

((eq  atm  t)  (list  name’t’/.'ctyp  7 ':■'/  'boolean'/;  7 
name’t’/.’bval  7 7 ’true'/;  7 

)) 

((eq  atm  false)  (list  name’t’/.’ctyp  7 ’:■’/  'boolean'/;  7 
name’t’/.’bval  7’:- ’/’false’/;  7 


» 

) 

)))))) 


(t  (append  (list  name’t’/.’ctyp  7 ':■'/  'symbol'/;  7 
(mk-sym  arg  (explode  arg)) 

(list  name’t’/.'sval  7 7 arg’/;  7 


(def  is-quoted  (x)  (cond  ((atom  x)  nil) 

(t  (eq  (first  x)  ’quote)))) 


(def  mk-sym  (name  charlist) 

(cond 

((memq  name  donelist)  ()) 

(t 

(addtocal-sym  name) 

(append  (list  'new  '/(  name  7)7;'/ 
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name ’T  7.  ’notempty  7 ’:■’/  ’fslie7;7 

) 

(do  ((chars  (reverse  chartist)  (rest  chars)) 

(ans  ()  ((lambda  (temp) 

(addlocal-sym  temp) 

(append 

(list  'new  '/( temp  7)7;  7 

temp  T/.’notempty  7 ’true7;7 
temp  'T’/.’firstch  7 ’:-’/  (first  chars)'/;’/ 
temp  't'/.'tail '/ ':-'/  name'/;  7 
name'/’:-’/  temp'/;'/ 

ans)) 

(gensym)))) 

((null  chars)  ans)))))) 


(def  fix -subgoals  (sbglist)  ;makes  a list  of  subgoals  whose  arglists  are  lists 
(cond  ;of  terms  for  which  the  pascal  code  has  been 

((null  sbglist)'(O))  -.generated,  its  value  is  the  new  sbglist  cons  onto 
(t  ((lambda  (first-ans  rest-ans)  ;the  list  of  pascal  stuff 
(cons 

(cons  (cons  (first  (first  sbglist))  ;i.e.,  subgoal  name 
(first  first-ans))  ;i.e.,  new  arglist 

(first  rest-ans))  ;the  other  subgoals 

(append  (rest  first-ans)  ;p-code  for  this  subgoal 

(rest  rest-ans))))  ;p-code  for  the  rest  of  the  subgoals 
(actualize  (rest  (first  sbglist)))  generates  stuff  for  one  arglist 
(fix-subgoals  (rest  sbglist)))))) 


(def  actualize  (arglist)  ;turns  an  arglist  in  intermediate  form,  into  a list 
(cond  ;of  terms-  the  value  is  the  new  arglist  cons'd  onto 

((null  arglist)'(O))  ;the  list  of  p-code 
(t  ((lambda  (arg-ans  rest-ans) 

(cons  (cons  (first  arg-ans) 

(first  rest-ans)) 

(append  (rest  arg-ans) 

(rest  rest-ans)))) 

(arg-to-term  (first  arglist)) 

(actualize  (rest  arglist)))))) 


(def  arg-to-term  (arg) 
(cond 

((is-var  arg) 
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(cond  ((memq  arg  donelist)  (list  arg)) 
(t  (cons  arg  (mk-term  arg  arg))))) 
(t  ((lambda  (name) 

(cons  name 

(mk-term  name  arg))) 
(gensym))))) 


;local-vars  and  donelist  are  global  to  several  of  the  above  functions.  They  are 
,the  means  by  which  information  about  which  terms  have  been  generated  and 
;must  be  declared  are  transmitted  about.  Local-vars  is  a list  of  4 lists  of 
;varlables  that  must  be  declared  as  termlists,  terms,  constants,  and  symbols, 
;respectively.  Every  time  a new  variable  is  created  it  is  added  to  this  list 
;in  the  appropriate  type  sublist.  Whenever  a variable  (pointer)  is  created 
;that  may  appear  again,  it  is  added  to  donelist  so  that  multiple  versions 
;need  not  be  generated. 


(def  mark-done  (name)  (setq  donelist  (cons-if-new  name  donelist))) 
(def  addlocal-tml  (name) 

(setq  local-vars  (cons  (cons-if-new  name  (first  local-vars)) 

(rest  local-vars)))) 

(def  addlocal-tm  (name) 

(setq  local-vars  (cons  (first  local-vars) 

(cons  (cons-if-new  name  (second  local-vars)) 
(rest  (rest  local-vars)))))) 

(def  addlocal-cnst  (name) 

(setq  local-vars  (cons  (first  local-vars) 

(cons  (second  local-vars) 

(cons  (cons-if-new  name  (third  local-vars)) 
(rest  (rest  (rest  local-vars)))))))) 


(def  addlocal-sym  (name) 

(setq  local-vars  (cons  (first  local-vars) 

(cons  (second  local-vars) 

(cons  (third  local-vars) 

(cons  (cons-if-new  name  (fourth  local-vars)' 

())))))) 
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The  following  programs  were  written  directly  in  Pascal  as  part  of  the  implementation 
of  the  "back  end’  for  the  language. 

(♦pascal  programs*) 

(*$E+«) 

program  Junk, Unify,Subst, Replace, Copytermlist,Copyterm,Copyconst,Copysym; 

(♦pascal  can't  handle  things  the  way  it  should  so  we  have  to  invent  strange 
names  that  are  all  referring  to  the  same  thing,  in  particular,  the  type 
of  the  object  at  hand.  Thus, 

alltyps,  an  Indication  of  the  possible  atomic  types,  is  actually  made 
up  of  convoluted  versions  of  the  type  names, 
this  idiocy  is  carried  on  throughout,  which  is  why  you’ll  see  several 
different  names  that  all  look  similar  but  had  to  be  different  for  pascal.  *) 

TYPE 

(«  A lltyps  are  the  types  of  atomic  constants  *) 

Alltyps  ^ (Integertyp,  Realtyp,  Booleantyp,  Chartyp,  Symboltyph 

Termtyps  - (Variable,  Constanttyp,  Funapp); 

Term  • TT 1; 

Termlist  • ITI1; 

Constant  - TCI; 

Symbol  - TSyml; 

Tl  - record 

case  TtypTermtyps  of 

Variable:  (Vr:  integer); 

Constanttyp:  (Cnst:  Constant); 

Funapp:  (Fnarne:  Symbol; 

Args:  Termlist) 

end; 

Tl  1 - record 

Notempty:  Boolean; 

First:  Term; 

Rest:  Termlist 
end; 


Cl  - record 
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cue  Ctyp-.AIItyps  of 

Integertyp:  (Ival:  Integer); 
Realtyp:  (Rval:  real); 
Booleantyp:  (Bval:  boolean); 
Chartyp:  (Cval:  char); 
Symbokyp:  (Sval:  Symbol) 
end; 

Syml  - record 

Notempty:  boolean; 

Firttch:  char; 

Tail:  Symbol 
end; 

Varpairt  - tVp; 

Vp  ■ record 

Notempty:  boolean; 

Old:  integer; 

New:  integer, 

Rett:  Varpairt 
end; 


function  Cenvaninteger; 
begin 

Cenvar.-  realtime 
endK*gcnvar») 

function  Occur<X,Y:Term):boolean; 
var  Ptr  Termliit; 

Flag:  boolean; 
begin 

if  YT.Ttyp  • Variable 
then  begin 

if  Yt.Vr  - Xt.Vr 
then  Occur :» true 
ebe  Occur  > fabe 
end 

elae  if  Yt.Ttyp  ■ Comtanttyp 
then  Occur  s» fabe 

ebe  begin 

Ptr  tm  YT-Argu 

Fbg :»  fabe; 

while  Ptrf  Jteicmpcy  and  (Flag  • fabe) 
do  begin 


•I 
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Flag  :■  OccuKX,  Ptrt.Flrst>, 

Ptr  :•  Ptrt.Rest 

end; 

Occur  :•  Flag 
end 

endK*Occur*) 


procedure  Replace{X,  T:  Term;  var  Tml:  Termliith 
var  TIITermllst; 

TI:Term; 

begin 

Til:-  Tml; 

while  TIlt.Notempty  do 
begin 

Tl  TIlt.Flrst; 

If  not(TIt.Ttyp  - Constanttyp) 
then  begin 

if  TIT.Ttyp  - Variable 
then  begin 

If  Xt.Vr  ■ Tlt.Vr 
then 

TIlt.Flrst  > T (*need  to  mung  record,  not  Just  ptr  tl«) 
(*else,  no  change  needed*) 
end 

else  (*it's  a funapp*) 

Replaced,  T,  Tllt.Firstt.Args) 

end; 

(*if  its  a constant  no  changes  need  be  made*) 

Til  Tmlt.Rest 
end  (*of  while*) 
end;  (*Replace«) 

procedure  Subst(X,  T.Term;  var  Tl,  T2:Termlist>, 
begin 

Replace(X,  T,  Tl>. 

Replace(X,  T.  T2) 
end; 


function  EqsymfX.YiSymbol):  boolean; 
begin 

while  Xt.Notempty  and  Yt.Not#mpty  and  (XtJIrstch  • Yt.Flrstch)  do 
begin 

X.-Xt.Tail; 

Y:-Yt.Tail 


. . 'l ' 
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end; 

if  Xt.Notempty  or  Yt.Notempty 
then  Eqsym:-  false 
else  Eqsym:-  true 


function  Eqconst(X,Y:Constant):boolean; 
begin 

if  Xt.Ctyp  - Yt.Ctyp 
then  case  Xt.Ctyp  of 

Jntegertyp:  Eqconst:-  XT.Ival  - YT.Ival; 
Realtyp:  Eqconst:-  XT.Rval  - YT.Rval; 
Booleantyp:  Eqconst:-  XT.Bval  - Yt.Bval; 
Chartyp:  Eqconst:-  Xt.Cval  - YT.Cval; 
Symboltyp:  Eqconst:-  Eqsym(XT.Sval>  YT-Sval) 


end 

else  Eqconst:-  false 
end; 


function  Copysym(Oldsym:Symbol):Symbol; 
var  Newsym,  Lastnode,  NewnodeSymbol; 

begin 

new<Newsym>, 

Lastnode  :>  Newsym; 
while  OldsymT.Notempty  do 
begin 

Lastnodet.Notempty :-  true; 
LastnodeLFirstch  :■  OldsymT.Firstch; 
new(Newnode>, 

Lastnodet.Tal!  :■  Newnode, 

Lastnode :-  Newnode; 

Oldsym :-  Oldsymt.Tail 
end; 

LastnodeT.Notempty :-  false, 

Copysym :-  Newsym 
end;  (*Copysym«) 


function  Copyterm(Oldtm:Term):Term; 
forward; 


function  Copytermlist(Tml:Termlist):Termlist; 
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var  Newnode,  Lastnode,  TmlnewiTermlist; 
begin 

newfTmlnew); 

Lastnode  :•  Tmlnew; 
while  Tmlt.Notempty  do 
begin 

LastnodeT.Notempty  :•  true, 

Lastnodet  .First  :■  Cop  yterm(Tmlt. First); 
new<Newnode>, 

Lastnodet.Rest  :■  Newnodr, 

Lastnode  :■  Newnode, 

Tml Tmlt.Rest; 
end; 

Lastnodet.Notempty false, 

Copytermlist Tmlnew 
end;  (*Copytermlist«) 


function  Copyconst(Oldconit.’Conitant}:Cpnstant; 
var  Newconst:Constant; 

begin 

new<Newconst>, 

Newconstt.Ctyp  :■  OldconstT.Ctyp; 
case  Newconstt.Ctyp  of 

Integertyp:  NewconstT.Ival  :•  OldconstT.Ival; 

Realtyp;  NewconstT.Rval  :■  O W const  T.Rval; 

Booleantyp:  Newconstt.Bval  > OldconstT.Bval; 
Chartyp:  Newconstt.Cval  :•  OldconstT.Cval; 
Symboltyp:  NewconstT^val  :•  Copysym(OldconstT.Sval) 
end;  (*of  case  stmt*) 

Copyconst  :•  Newconst 
end;  (*Copyconst«) 


function  Copyterm; 
var  Newtm:Term; 

begin 

nevKNewtm); 

NewtmT.Ttyp  :■  Oldtmt.Ttyp; 
case  Newtmt.Ttyp  of 

Variable:  Newtmt.Vr  :•  OldtmT.Vr;  (alt's  Just  an  integer*) 
Constanttyp:  NewtmT.Cnst CopyconstfOldtmT.Cnit); 
Funapp:  begin 

NewtmT.Fname  :•  Copysym(01dtmt  Jnamefc 
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Newtmt.A  rgs  Copytermli*t{0 Idtmt  A rgs) 

end 

end;  (*of  ctse  stmt*) 

Copyterm  :■  Newtm 
end;  (*Copyterm«) 


(*the  first  call  on  unify  will  repeat  the  arglists  being  unified-  dumb,  but  it 
makes  it  possible  to  accomplish  the  substitutions  by  replacement  as  we  go  instead 
of  building  a substitution  and  making  new  copies  of  everything  every  time  we  do 
a substitution,  the  allx  and  ally  args  are  necessary  to  ensure  that  any  replacements 
resulting  from  recursive  calls  get  made  throughout  the  entire  termlists  you  started 
with*) 

function  Unlfy(var  X,  Y,  Allx,  Ally:  Termlist;  Failed:boolean>.  boolean; 
var  XI,  Yl:  Termlist; 

X2,  Y2:  Term; 

Dummy,  Subfailed:  boolean; 
begin 

(•initialize*) 

Failed  False, 

XI  X; 

Yl  Y; 

while  Xlt.Notempty  and  Ylt.Notempty  and  not(Failed)  do 
begin 

X2  X IT.First; 

Y2  Y It. First, 
if  X2t.Ttyp  - Variable 
then  begin 

if  Y2t.Ttyp  - Variable 
then  X2T.Vr  > Y2t.Vr 

(*  if  they’re  already  the  same,  the  assignment  is  unnecessary 
but  cheaper  than  testing  the  equality  and  wont  hurt  anything?*) 
else  if  Occur(X2,  Y2) 
then  Failed  > true 
else  Subst(X2,  Y2,  X,  Y) 
end 

else  if  Y2t.Ttyp  - Variable 
then  begin 

If  Occur(Y2,  X2) 
then  Failed  :■  true 
else  Subst(Y2,  X2.  X,  Y) 
end 

else  if  X2t.Ttyp  - Constanttyp 
then  begin 

if  Y2t.Ttyp  - Constanttyp 
then  begin 


b > 

% . 

f 

v 


Appendix  Ci  LUUaf  of  the  Ijntn  1(1 


If  not(  Eqconst(X2t.Cnst,  Y2t.CnM) ) 
then  Failed  :■  true, 

(*lf  they  are  - nothing  need  be  done*) 
end 

else  Failed :■  true 
end 

else  (*X2  is  a funapp  and  Y2  is  not  a variable*) 
if  Y2t.Ttyp  - Constanttyp 
then  Failed  :•  true 

else  (*X2  and  Y2  are  both  funapp  terms*) 
if  Eqsym(X2T.Fname,  Y2t.Fname) 
then  begin 

Dummy  :• 

Unify<X2tArgs,  Y2t.Args, 

Allx,  Ally,  Subfailed)-, 
if  Subfailed 
then  Failed true 
end 

else  Failed  :-true; 

XI  :•  X IT. Rest; 

Yl  :■  Y It. Rest 
end;  (*of  while*) 

if  X IT.Notempty  or  YIT.Notempty  then  Failed  :■  true; 

Unify  > not  Failed 
end;  (*Unify») 

function  Lessthan(X,  Y:Term;  var  Z:Term>. boolean; 

var  Con:  Constant; 

begin 

ZT.Ttyp  :■  Constanttyp; 
new(Con); 

ZT.Cnst  Con; 

Cont.Ctyp Booleantyp; 
if  Xt.CnstT.Ival  < Yt.Cnstt.Ival 
then  Zt.Cnut.Bval  :•  true 
else  Zt.CnMt.Bval  :■  false; 

Lesuhan  :•  true 
end; 

function  Greater  equaKX,  Y:Term;  var  Z:  Term):  boolean; 

var  Con:  Constant; 

begin 

Zt.Ttyp  :•  Constanttyp; 
new(Con>, 

Cont.Ctyp :-  Booleantyp; 

Zt.CnM  :■  Con; 
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If  Xt.Cnttt.Ival  >-  Yt.CnttT.Ival 
then  Zt.Cnttt.Bval true 
elie  Zt.Cnttt.Bval false; 

Createrequal  ;•  true 
end; 

function  Times(X,  Y.Term;  var  ZiTerm):  boolean; 

var  Con:Constant; 

begin 

Zt.Ttyp  :•  Constanttyp; 
new(Con); 

Cont.Ctyp  :•  Integertyp; 

Zt.Cntt  :•  Con; 

Cont.Ival Xt.Cnttt.Ival  * Yt.Cnttt.Ival; 
Times  :•  true 
end; 

function  Subl(X:  Term;  var  Y:Term):boolean; 

var  ConConstant; 

begin 

Yt.Ttyp  ;■  Constanttyp; 
new(Con); 

Cont.Ctyp :•  Integertyp; 

Yt.Cntt Con; 

Cont.Ival Xt.Cnttt.Ival  - I; 

Subl  :•  true 
end; 


procedure  Lookup(Tm:Term;  Tbl:  Varpairs;  Found:  boolean); 

var  Ptr:  Varpairs; 

begin 

Found  :»  false; 

Ptr Tbl; 

while  Ptrt.Notempty  and  not  Found 
do  begin 

If  Ptrt.Old  • Tmt.Vr 
then  begin 

Tmt.Vr Ptrt.New; 

Found true 
end; 

Ptr PtrT.Rett 
end 

end;  (*Lookup«) 
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procedure  Stand apart(Tml:  Termliit;  var  Donetbl:  Varpalrt>, 
var  Ptr:  Termllst; 

Done:  Varpairs; 

Found:  boolean; 
begin 
Ptr:-  Tml; 
while  Ptrt.Notempty 
do  begin 

If  Ptrt.Firitt.Ttyp  ■ Variable 
then  begin 

Lookup(Ptrt. First,  Donetbl,  Found); 
if  not  Found 
then  begin 
new(Done); 

Donet.Notempty  :■  true, 

DoneT.Old :-  Ptrt.Fir*tT.Vr; 

Donet.New  :•  Cenvar; 

Ptrt.Firstt.Vr  :•  Donet.New; 

Donet.Rest  :>  Donetbl; 

Donetbl  :■  Done 
end 
end 

else  if  Ptrt.Firitt.Ttyp  • Funapp 

then  Standapart(Ptrt.Firstt.Args,  Donetbl), 

Ptr Ptrt.Re$t 
end 

end;  (*Stand  apart*) 


begin  (*Junk,  ie,  main  program*) 
end. 
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